如何将文件夹中多个 Excel 工作簿中的数据复制到主工作表中？答案

【问题标题】：How to copy data from multiple Excel workbooks in a folder into main sheet?如何将文件夹中多个 Excel 工作簿中的数据复制到主工作表中？
【发布时间】：2020-12-11 21:25:38
【问题描述】：

我有一个“主文件”，我想从测试文件夹中的多个 Excel 工作簿中复制数据。
我做了一个宏，它打开每个文件并粘贴到主文件中。

它每次都在主文件中创建一个单独的工作表。
我希望它在找到主文件的最后一行后将数据粘贴到同一张表中。

Copy to clipboard
Sub ConslidateWorkbooks1()
    Dim FolderPath As String
    Dim Filename As String
    Dim Sheet As Worksheet
    Application.ScreenUpdating = False
    FolderPath = Environ("userprofile") & "\Desktop\Carrier\Test\"
    Filename = Dir(FolderPath & "*.xls*")
    Do While Filename <> ""
        Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
        For Each Sheet In ActiveWorkbook.Sheets
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
        Next Sheet
        Workbooks(Filename).Close
        Filename = Dir()
    Loop
    Application.ScreenUpdating = True
End Sub

【问题讨论】：

不要使用Sheet.Copy，而是查看Range.Copy 或其他Range 方法来复制数据。 Sheet.Copy 是每次创建新工作表的行。将Range 复制到工作表后，只需找到lastRow 即可知道将下一组数据复制到何处。

标签： excel vba

【解决方案1】：

我认为问题行是Sheet.Copy After:=ThisWorkbook.Sheets(1)。如果您想粘贴到同一张表 - 在下一个可用行，那么您需要找出该行是什么。以下代码未经测试，但应该给你你想要的。让我知道你是怎么做的。

Option Explicit
Sub ConslidateWorkbooks1()
Dim FolderPath As String, Filename As String, Sh As Worksheet, PasteToRow As Long
On Error GoTo GetOut

Application.ScreenUpdating = False
FolderPath = Environ("userprofile") & "\Desktop\Carrier\Test\"
Filename = Dir(FolderPath & "*.xls*")
PasteToRow = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1

Do While Filename <> ""
    Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
    For Each Sh In ActiveWorkbook.Sheets
        'Sheet.Copy After:=ThisWorkbook.Sheets(1) '<~~ the line causing the problem
        Sh.Cells.Copy ThisWorkbook.Sheets(1).Range("A" & PasteToRow)
        PasteToRow = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
    Next Sh
    Workbooks(Filename).Close
    Filename = Dir()
Loop

GetOut:
    MsgBox Err.Description
    Application.ScreenUpdating = True
    Exit Sub

End Sub

【讨论】：