How to copy data from multiple Excel workbooks in a folder into main sheet?

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

Instead of using Sheet.Copy, look at Range.Copy or other Range methods to copy the data over. The Sheet.Copy is the line that is creating a new sheet every time. After you copy the Range to the sheet, just find the lastRow so you know where to copy the next set of data. — PeterT

Unknown Unknown · Accepted Answer · 2020-12-13T21:59:32

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

How to copy data from multiple Excel workbooks in a folder into main sheet?

1 Answers