首页 > 解决方案 > VBA 不工作(从一个文件复制数据并粘贴到最后一行数据下方的不同工作簿)

问题描述

有人可以帮我解决这个问题吗?它在粘贴阶段分解。

Sub GetFileCopyLabour()

   Dim Fname As String
   Dim SrcWbk As Workbook
   Dim DestWbk As Workbook
   Dim lDestLastRow As Long

   Set DestWbk = ThisWorkbook

   Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
   If Fname = "False" Then Exit Sub
   Set SrcWbk = Workbooks.Open(Fname)

   lDestLastRow = DestWbk.Sheets("Labour Dump").Cells(DestWbk.Sheets("Labour Dump").Rows.Count, "A").End(xlUp).Offset(1).Row

   SrcWbk.Sheets("DATA DUMP").Range("A:AX").Copy DestWbk.Sheets("Labour Dump").Range("A:AX" & lDestLastRow)
   SrcWbk.Close False

End Sub

标签: excelvbapaste

解决方案


所以这是我修改后的代码,除了粘贴特殊值之后的两行之外,它工作正常。我正在尝试在单元格 AY2 和 AZ2 中获取公式以复制新数据范围的整个列,但目前它只对第一个新行执行此操作。你知道怎么修吗?有问题的代码位于双星号内,这不是原始代码的一部分!

子 GetFileCopyLabour()

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.Calculation = False

Dim Fname As String Dim SrcWbk As Workbook Dim DestWbk As Workbook Dim lDestLastRow As Long

Set DestWbk = ThisWorkbook

Fname = Application.GetOpenFilename(FileFilter:="Excel Files (.xls), .xls", Title:="Select a File")
If Fname = "False" Then Exit Sub
Set SrcWbk = Workbooks.Open(Fname)

lDestLastRow = DestWbk.Sheets("Labour Dump").Cells(DestWbk.Sheets("Labour Dump").Rows.Count, "A").End(xlUp).Offset(1).Row

SrcWbk.Sheets("DATA DUMP").Range("A2:AX2000").Copy
DestWbk.Sheets("Labour Dump").Range("A" & lDestLastRow).PasteSpecial xlPasteValues
**DestWbk.Sheets("Labour Dump").Range("AY2:AZ2").Copy
DestWbk.Sheets("Labour Dump").Range("AY2:AZ" & lDestLastRow).FillDown**

SrcWbk.Close False


Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
Application.Calculation = True

结束子


推荐阅读