VBA无法正常工作（从一个文件复制数据并粘贴到最后一行数据下面的不同工作簿）

Question

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

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

Answer 1

这对我有用：

Sub GetFileCopyLabour()

    Dim Fname As String
    Dim SrcWbk As Workbook
    Dim DestWbk As Workbook
    Dim lDestLastRow As Long
    Dim SrcWbkLastRow 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
    SrcWbkLastRow = SrcWbk.Sheets("DATA DUMP").Cells.Find(what:="*", After:=SrcWbk.Sheets("DATA DUMP").Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).row

    SrcWbk.Sheets("DATA DUMP").Range("A1:AX" & SrcWbkLastRow).Copy
    DestWbk.Sheets("Labour Dump").Range("A" & lDestLastRow).PasteSpecial

    SrcWbk.Close False

End Sub

Answer 2

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

Sub 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

结束子