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 中获取公式以复制新数据范围的整个列，但目前它仅对第一行执行此操作。 你知道怎么修吗？ 有问题的代码位于双星号内，这不是原始代码的一部分！

子 GetFileCopyLabour()

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

将 Fname 变暗为字符串 将 SrcWbk 变暗为工作簿 将 DestWbk 变暗为工作簿 将 lDestLastRow 变暗为长

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

结束子