Copy data from multiple single-worksheet workbooks into another workbook that contains formulas

[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

 

[JLGWhiz]

It is a little hard to believe that all 2000 workbooks in the folder are named (A) and it will throw an error if the new workbooks are all named (C), so lets start with some clarification.
1. Are the 2000 workbooks in the same folder as workbook (B)?
2. Will workbook (B) be the host for the macro?
3. If Not 1 and 2, we need the directory path for the 2000 files.
4. Explain what you mean by saving the file as workbook (C). New name? Why?

 

[JLGWhiz]

This is something like what the code would look like. But the red font items need to be edited because that data was not provided in the post and it is arbitrary in this code.

Sub t()
Dim wb As Workbook, sh As Worksheet, fName As String, fPath As String
Set sh = [COLOR=#ff0000]ThisWorkbook.[/COLOR]Sheets(1)
fPath = [COLOR=#ff0000]ThisWorkbook[/COLOR].[COLOR=#ff0000]Path[/COLOR]
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
fName = Dir(fPath & "*.xl*")
    Do While fName <> ""
        Set wb = Workbooks.Open(fPath & fName)
        wb.Sheets(1).UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
        wb.Close False
        fName = Dir
    Loop
[COLOR=#FF0000]ThisWorkbook[/COLOR].SaveAs "[COLOR=#ff0000]myFile" & Format(Date, "mm-dd-yyyy") [/COLOR]& ".xlsm"
End Sub

 

[dansor]

Thank you very much, JLGWhiz, for the quick reply, and I apologise for not describing my situation clearly.

1. The 2000 workbooks are named differently - I called them A in my question as they are of a similar type (containing the initial data), as distinct from the workbook B (containing the formulas). The 2000 workbooks are in one folder and the workbook B with the formulas will be in a separate folder.
2. Probably it is best for workbook B to be the host of the macro.
3. The 2000 workbooks are in the C:\A\ folder, while the workbook B will be in the C:\B\ folder
4. I was thinking that, once copied into the workbook type B, each workbook type A should be saved as a new file, but I guess it can be saved as the original workbook type A.

I hope I made myself clearer. Thanks again!

dansor

It is a little hard to believe that all 2000 workbooks in the folder are named (A) and it will throw an error if the new workbooks are all named (C), so lets start with some clarification.
1. Are the 2000 workbooks in the same folder as workbook (B)?
2. Will workbook (B) be the host for the macro?
3. If Not 1 and 2, we need the directory path for the 2000 files.
4. Explain what you mean by saving the file as workbook (C). New name? Why?

 

[JLGWhiz]

Try this modified version

Sub t2()
Dim wb As Workbook, sh As Worksheet, fName As String, fPath As String
Set sh = ThisWorkbook.Sheets(1)
fPath = "C:\A\"
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
fName = Dir(fPath & "*.xl*")
    Do While fName <> ""
        Set wb = Workbooks.Open(fPath & fName)
        wb.Sheets(1).UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
        wb.Close False
        fName = Dir
    Loop
'ThisWorkbook.SaveAs "myFile" & Format(Date, "mm-dd-yyyy") & ".xlsm"
End Sub

The source workbooks will not be saved as new files but will remain as their original identity. If you want to save your master copy as a different name each time, you can give it a basic name and substitute that for "myFile" and the date it is saved will be added to make it a unique name in the line before 'End Sub'. Remove the comment symbol if you want to use that line of code.