VBA 将数据从多个工作簿复制到主表中

Question

我必须从 100 多个工作簿中复制数据并将其粘贴到主工作簿中。 所有工作簿都位于我桌面上的一个文件夹中：C:\\Users\\brw20\\Desktop\\Project XYZ\\Updated\\

所有工作簿都包含一个名为“突变”的工作表，我必须打开每个工作簿，转到“突变”工作表，选择从第 3 行到第 'x' 行的列范围 A 到 J（每个工作簿中的最后一行可能有所不同） . 在主工作表中，我将 A 列中的数据粘贴到 J 列中，并在从更多工作簿复制数据时继续粘贴/附加数据。 我试过的下面给出的代码已修复。 由于弹出窗口生成的行数（“剪贴板上有大量信息。您是否希望稍后能够将此信息粘贴到另一个程序中。”）针对每个复制表。 所以，我想知道是否有人可以帮我为此创建一个 VBA 代码，它只复制固定列但复制可变行？ 我真的是 VBA 的新手，非常感谢您的帮助！

如果您需要任何说明，请告诉我。

非常感谢！ =)

Sub LoopThroughDirectory()
Dim MyFile As String
Dim wb As Workbook
Dim ws As Worksheet

sPath = "C:\Users\brw20\Desktop\Project XYZ\Updated\"
Dim erow
MyFile = Dir(sPath & "*.xlsx")
Application.ScreenUpdating = False
Do While MyFile <> ""
If MyFile = "zmaster.xlsm" Then
Exit Sub
End If
Workbooks.Open (sPath & MyFile)
'Set ws = wb.Sheets(2)
Worksheets("Mutation").Range("A3:J1000").Copy
'Call CopyValues(Sheet1.Range("A1:B12"), Sheet1.Range("A1:B12"))
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 1))
'Workbooks.Open ThisWorkbook.Path & "\DgetData.xls"
MyFile = Dir
Loop

End Sub

Answer 1

1. 尽量避免使用ActiveWorkbook和ActiveSheet ，而是使用直接引用，如下所示：

    Set wbMast = Workbooks.Open(ThisWorkbook.Path & "\\DgetData.xls") Set wbSrc = Workbooks.Open (sPath & MyFile)

2. 此命令（有 2 个变体）通过在源和目标范围中查找最后一个非空单元格来动态选择源和目标范围进行复制：

    Range(wbSrc.Worksheets("Mutation").cells(1, 3), _ wbSrc.Worksheets("Mutation").Cells(100000, "J").end(xlup)).Copy _ destination:=wbMast.Sheets(1).Cells(1,1).End(xlUp).Offset(1,0)

或使用With的更压缩变体

   With wbSrc.Worksheets("Mutation")
        Range(.cells(1, 3), .Cells(100000, "J").end(xlup)).Copy  _
            destination:=wbMast.Sheets(1).Cells(1,1).End(xlUp).Offset(1,0)
   End With

（这个检查 wbMast 中的 A 列和 wbSrc 中的 J 列是否为最后一个非空单元格。）

3. 如果您仍然收到“...大量信息...”的消息，

    Application.DisplayAlerts = False

可能会抑制消息。