PDA

View Full Version : Copy data from multiple single-worksheet workbooks into another workbook



dansor
01-28-2018, 05:42 PM
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
01-28-2018, 10:32 PM
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