Excel VBA 复制并粘贴到现有数据末尾的不同工作簿

Excel VBA 复制并粘贴到现有数据末尾的不同工作簿

我正在尝试将来自多个工作簿的数据合并到一个主工作簿中,我有 3 个工作簿,它们都有一个名为公司选项卡,并且我希望将它们包含的所有数据粘贴到同一选项卡上的新工作簿中。

然后,我希望能够对其他 13 个没有相同列数的选项卡重复此操作,因此我需要它来查找最后一行和最后一列,而不是指定范围

我从几个网站拼凑了以下代码,但无法使其工作。我在复制和粘贴部分不断收到错误 1004。任何建议都将不胜感激。提前谢谢

Sub Copy_Paste_Below_Last_Cell()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lastCol As Long
Dim lDestLastRow As Long
Dim lastRow As Long

  Set wsCopy = Workbooks("Source.xlsm").Worksheets("Company")
  Set wsDest = Workbooks("Target.xlsx").Worksheets("Company")

  '1. Find last used row in the copy range based on data in column A

      lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, 1).End(xlUp).Row

    ' Get the last cell with data in row 1
    lastCol = wsCopy.Cells(1, wsCopy.Columns.Count).End(xlToLeft).Column

  '2. Find first blank row in the destination range based on data in column A

  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row

  '3. Copy & Paste Data

    wsCopy.Range(Cells(1, 1), Cells(lCopyLastRow, lastCol)).Copy
    wsDest.Paste Destination:=("A" & lDestLastRow)

End Sub

答案1

您需要将工作表添加到Cells(),即使它在wsCopy.Range()

wsCopy.Range(wsCopy.Cells(1,1), wsCopy.Cells(lCopyLastRow, lastCol)).Copy

您可以在一行中完成此操作(我将使用With它使其更容易阅读:

With wsCopy
    .Range(.Cells(1, 1), .Cells(lCopyLastRow, lastCol)).Copy wsDest.Range("A" & lDestLastRow)
End With

相关内容