Copy data from multiple single-worksheet workbooks into another workbook

[dansor]

I have 2000+ workbooks (A) in a folder (each having only one worksheet with data structured the same across all the workbooks). I also have another workbook (B) in a separate folder with:

• The first worksheet structured the same as the 2000+ single-worksheet workbooks and
• 4 additional worksheets that contain formulas that refer to the data from the first worksheet.

I would like to have a macro that loops through all the 2000+ workbooks (A) and for each workbook (A):

• Copies data from the single worksheet inside it
• Pastes it in the first worksheet on the other workbook (B)
• Saves the updated workbook (B) as workbook (C).

Is that even possible?

Thank you very much.
dansor

[georgiboy]

Welcome to the forum,

This may not be the fastest way but it will get the ball rolling:

Sub LoopFiles()
    Dim fWB As Workbook, dWB As Workbook, dWS As Worksheet
    Dim fPath As String, dPath As String, x As Long
    Dim fl As String, ext As String
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual

        fPath = "C:\Users\Example\Desktop\From\"
        dPath = "C:\Users\Example\Desktop\To\"
        ext = "*.xlsx"
        x = 0
        fl = Dir(fPath & ext)
        Set dWB = Workbooks.Open(dPath & "B.xlsx")
        Set dWS = dWB.Sheets("Sheet1")
        
        Do While fl <> ""
            x = x + 1
            Set fWB = Workbooks.Open(fPath & fl)
            Range("A1:A2").Copy
            dWS.Cells(1, 1).PasteSpecial xlPasteValues
            .CutCopyMode = False
            dWB.SaveCopyAs dPath & "C-" & x & ".xlsx"
            fWB.Close
            fl = Dir
        Loop
    
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
    dWB.Close False
End Sub

Hope this helps