We have multiple workbooks, with 10 worksheets. Each worksheet has a specific name.
As an example, we could call them Sheet 1 to Sheet 10. (They are actually called QB-4.1 DA, QB-4.2 DA, QB-4.3 DA, etc.)
The format of all Sheet1's are same in all workbooks.
The format of all Sheet2's are same in all workbooks, etc.
We would like to do the following in a separate workbook called Output.xlsm
In Output.xlsm-> Sheet1:
Same as above for all other sheets in Output.xlsm . i.e., Output.xlsm-> Sheet2:
Maintain the SheetNames.
This code combines all data from all workbooks and all worksheets into one single sheet, and the combining of data does not remove the headers etc.
Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'change folder path of excel files here
Set dirObj = mergeObj.GetFolder("C:\consolidated\")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
End Sub
Example Workbooks:
Can you try this?
I haven't looked as your files so some adjustments may be needed.
Sub simpleXlsMerger()
Dim bookList As Workbook, bFirst As Boolean, ws As Worksheet, wsO As Worksheet
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim rCopy As Range
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("C:\consolidated\")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
For Each ws In bookList.Worksheets
If Not bFirst Then
Set wsO = ThisWorkbook.Worksheets.Add()
wsO.Name = ws.Name
Set rCopy=ws.range("A1").currentregion
'Set rCopy = ws.Range("A1", ws.Range("IV" & Rows.Count)).End(xlUp)
Else
Set wsO = ThisWorkbook.Worksheets(ws.Name)
Set rCopy=ws.range("A1").currentregion
Set rCopy=rcopy.offset(1).resize(rcopy.rows.count-1)
'Set rCopy = ws.Range("A2", ws.Range("IV" & Rows.Count)).End(xlUp)
End If
rCopy.Copy wsO.Range("A" & Rows.Count).End(xlUp)(2)
Next ws
bookList.Close
bFirst = True
Next
End Sub