The below vba code is to consolidate for excel sheets and excel files. This code meets your consolidation requirement and no need to worry about whether you have sheets or workbooks, however it will understand your requirement and perform accordingly.
Sub ConsolidateBooksandSheets()
Dim selectedpath As String
Dim strpath As Object
Dim fso As Object
Dim SheetsCount As Integer
Dim LastColumn, LastRow As Integer
Application.DisplayAlerts = False
Set fso = CreateObject("scripting.filesystemobject")
selectedpath = "C:\Users\KorampT\Desktop\Miscellaneous" & "\" 'Give your files location path
Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Consolidated File.xlsx" ' The consolidated file will save where thisworkbook saved
For Each strpath In fso.getfolder(selectedpath).Files
If Right(strpath, 5) = ".xlsx" Or Right(strpath, 4) = ".xlsx" Or Right(strpath, 5) = ".xlsb" Then
Workbooks.Open strpath
If ActiveWorkbook.Sheets.Count > Workbooks("Consolidated File.xlsx").Sheets.Count Then
a = ActiveWorkbook.Sheets.Count
b = Workbooks("Consolidated File.xlsx").Sheets.Count
For c = b + 1 To a
Workbooks("Consolidated File.xlsx").Sheets.Add after:=Sheets(c - 1)
Next c
End If
For SheetsCount = 1 To ActiveWorkbook.Sheets.Count
ActiveWorkbook.Sheets(SheetsCount).Activate
LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If ActiveSheet.Range("a1").Value <> "" Then
If Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Range("a1").Value = "" Then
ActiveSheet.Range(Cells(1, 1), Cells(LastRow, LastColumn)).Copy
Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Range("a" & Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Cells(Rows.Count, 1).End(xlUp).Row).PasteSpecial
Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Name = ActiveSheet.Name
Else
ActiveSheet.Range(Cells(2, 1), Cells(LastRow, LastColumn)).Copy
Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Range("a" & Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial
End If
End If
Next SheetsCount
ActiveWorkbook.Close
End If
Next strpath
Workbooks("Consolidated File.xlsx").Save
End Sub
- Copy the below code and paste it in vba editor and save, otherwise it will get an error.
- And the Consolidated file will gonna save in the location where your macro file saved.
Sub ConsolidateBooksandSheets()
Dim selectedpath As String
Dim strpath As Object
Dim fso As Object
Dim SheetsCount As Integer
Dim LastColumn, LastRow As Integer
Application.DisplayAlerts = False
Set fso = CreateObject("scripting.filesystemobject")
selectedpath = "C:\Users\KorampT\Desktop\Miscellaneous" & "\" 'Give your files location path
Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Consolidated File.xlsx" ' The consolidated file will save where thisworkbook saved
For Each strpath In fso.getfolder(selectedpath).Files
If Right(strpath, 5) = ".xlsx" Or Right(strpath, 4) = ".xlsx" Or Right(strpath, 5) = ".xlsb" Then
Workbooks.Open strpath
If ActiveWorkbook.Sheets.Count > Workbooks("Consolidated File.xlsx").Sheets.Count Then
a = ActiveWorkbook.Sheets.Count
b = Workbooks("Consolidated File.xlsx").Sheets.Count
For c = b + 1 To a
Workbooks("Consolidated File.xlsx").Sheets.Add after:=Sheets(c - 1)
Next c
End If
For SheetsCount = 1 To ActiveWorkbook.Sheets.Count
ActiveWorkbook.Sheets(SheetsCount).Activate
LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If ActiveSheet.Range("a1").Value <> "" Then
If Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Range("a1").Value = "" Then
ActiveSheet.Range(Cells(1, 1), Cells(LastRow, LastColumn)).Copy
Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Range("a" & Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Cells(Rows.Count, 1).End(xlUp).Row).PasteSpecial
Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Name = ActiveSheet.Name
Else
ActiveSheet.Range(Cells(2, 1), Cells(LastRow, LastColumn)).Copy
Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Range("a" & Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial
End If
End If
Next SheetsCount
ActiveWorkbook.Close
End If
Next strpath
Workbooks("Consolidated File.xlsx").Save
End Sub