Copy data from multiple single-worksheet workbooks into another workbook

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

Welcome to the forum,

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

Code:

---

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