Sub ConsolidateWorkbooksWithSourceFile()
Dim wsMaster As Worksheet
Dim wsSource As Worksheet
Dim rngSource As Range
Dim LastRowMaster As Long, LastRowSource As Long
Dim FileDialog As FileDialog
Dim FilePath As String, FileName As String
Dim wbSource As Workbook
Dim i As Integer
Dim colCount As Integer
Dim wsName As String
On Error GoTo ErrorHandler ' Enable error handling
' Open File Dialog to Select Files
Set FileDialog = Application.FileDialog(msoFileDialogFilePicker)
With FileDialog
.AllowMultiSelect = True
.Title = "Select Excel Files to Consolidate"
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx, *.xlsm, *.xls"
If .Show = False Then
MsgBox "No files were selected. Exiting..."
Exit Sub ' Exit if no file is selected
End If
End With
' Loop through each selected file
For i = 1 To FileDialog.SelectedItems.Count
FilePath = FileDialog.SelectedItems(i)
FileName = Dir(FilePath) ' Extract the workbook name
' Attempt to open the source workbook
On Error Resume Next ' Skip error for this block and handle it later
Set wbSource = Workbooks.Open(FilePath)
If wbSource Is Nothing Then
MsgBox "Failed to open file: " & FilePath, vbCritical
GoTo NextFile ' If file cannot be opened, skip to the next one
End If
On Error GoTo ErrorHandler ' Reset error handling for other operations
' Loop through each worksheet in the source workbook
For Each wsSource In wbSource.Sheets
wsName = wsSource.Name ' Get the name of the worksheet in the source workbook
' Check if a sheet with the same name exists in the master workbook
On Error Resume Next
Set wsMaster = ThisWorkbook.Sheets(wsName)
On Error GoTo ErrorHandler
' If the sheet doesn't exist, create a new one
If wsMaster Is Nothing Then
Set wsMaster = ThisWorkbook.Sheets.Add
wsMaster.Name = wsName
End If
' Find the last row of the master worksheet
LastRowMaster = wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row + 1
' Get the last row of data in the source worksheet
LastRowSource = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
If LastRowSource > 1 Then ' Ensure there is data to copy
Set rngSource = wsSource.Range("A1:Z" & LastRowSource) ' Adjust range if necessary
' Get the number of columns in the source data
colCount = rngSource.Columns.Count
' Copy data to the master worksheet
On Error Resume Next ' Handle any error that may occur during copying
rngSource.Copy
If Err.Number <> 0 Then
MsgBox "Error copying data from sheet " & wsSource.Name & " in file " & FileName,
vbCritical
Err.Clear
GoTo NextSheet ' Skip to the next sheet if copy fails
End If
wsMaster.Cells(LastRowMaster, 1).PasteSpecial Paste:=xlPasteAll
' Add the file name and sheet name in the next two columns
wsMaster.Range(wsMaster.Cells(LastRowMaster, colCount + 1), _
wsMaster.Cells(LastRowMaster + LastRowSource - 1, colCount + 1)).Value =
FileName
wsMaster.Range(wsMaster.Cells(LastRowMaster, colCount + 2), _
wsMaster.Cells(LastRowMaster + LastRowSource - 1, colCount + 2)).Value =
wsSource.Name
' Move to next available row
LastRowMaster = wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row + 1
End If
NextSheet:
Next wsSource
wbSource.Close False ' Close source workbook without saving
NextFile:
Next i
' Clean up
Application.CutCopyMode = False
MsgBox "Data Consolidation Complete!", vbInformation, "Success"
Exit Sub ' Exit to avoid the error handler
ErrorHandler:
' Handle errors
MsgBox "An error occurred: " & Err.Description, vbCritical
If Not wbSource Is Nothing Then wbSource.Close False ' Close workbook if it's open
Application.CutCopyMode = False
End Sub
<<<<RANGE IS NOT DYNAMIC, IT WONT GO BEYOND COLUMN Z, ADJUST IT ACCORDING TO THE
MAXIMUM NUMBER OF COLUMNS IN ("A1:Z" & LastRowSource), DO NOT COPY THIS>>>>>
<<<<STEPS : INSERT MODULE IN VBA(ALT+F11), THEN RUN THE MODULE(ALT+F8)>>>>>
