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

Question

I have one "main file" and I want to copy data from multiple Excel workbooks in Testing folder.
I made a macro and it is opening each file and pasting into main file.

It is creating an individual sheet every time in the main file.
I want it to paste data in the same sheet after finding the last row in the main file.

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

I think the problem line is Sheet.Copy After:=ThisWorkbook.Sheets(1) . If you want to paste to the same sheet - at the next available line, then you need to find out what that line is. The following code is untested, but should give you what you want. Let me know how you go with it.

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