如何將文件夾中多個 Excel 工作簿中的數據復制到主工作表中？

Question

我有一個“主文件”，我想從測試文件夾中的多個 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

Answer 1

我認為問題是Sheet.Copy After:=ThisWorkbook.Sheets(1) 。 如果您想粘貼到同一張表 - 在下一個可用行，那么您需要找出該行是什么。 以下代碼未經測試，但應該給你你想要的。 讓我知道你如何使用它 go。

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