Consolidating Multiple Workbooks into One Workbook by matching Sheet Names and Column Heads

Hi all of you,

This time I have come up with a macro which will consolidate or combine all Multiple Workbooks in one workbook. It will do so by Comparing the Sheet names and Column Heads as well. All you have to do is to make a Main Book containing all sheet names as exact as in the Extract books and with Exact Column heads in the same manner.

Then Run this macro by inserting a Module in the VBA editor.

It clears all data in the Main Book except column heads before pulling any data.

So here are the steps:-

1. Make a workbook as I have said.

2. Put all your Individual files or Extract files in one Folder.

3. Assign this path to FPath Variable in the Code. (That's important, otherwise it won't work)

4. The Main Book should not be downloaded or copied or saved in the Extract Folder.

5. Run the Macro.

6. If you have any problem in implementing the code in your actual workbook, then just give a com
ment.

       
Sub MergeAll()
Dim MainSh As Worksheet
Dim SubSh As Worksheet
Dim SearchIn As Range

Application.ScreenUpdating = False
Application.StatusBar = "Please Wait...."
                                            
'Change the file path for extracts
FPath = "C:\Users\Vikas Gautam\Desktop\Extracts\Extracts\Extracts"
MainBook = ThisWorkbook.Name
FName = Dir(FPath & "\" & "*.xl*")
                                            

For Each Sh In ThisWorkbook.Sheets                               'Clearing Previous Contents in the MainBook
    Sh.Cells(1, 1).CurrentRegion.Offset(1, 0).ClearContents
Next
                                            
Do While FName <> ""
 
 Workbooks.Open (FPath & "\" & FName)                            'Opening Extract Workbook
 For Each MainSh In Workbooks(MainBook).Sheets                   'Taking MainBook as Base
  Lr = MainSh.UsedRange.Rows.Count + 1                           'Marking the Last row where data is to
                                                                 'be pasted in the Sheet in MainBook
  For Each SubSh In Workbooks(FName).Sheets
   
   If MainSh.Name = SubSh.Name Then                              'Checking if Sheet Name matches with that of MainBook
    
    Set SearchIn = SubSh.Rows(1)
    For c = 1 To MainSh.Cells(1, Columns.Count).End(xlToLeft).Column
     
     ColFnd = Application.Match(MainSh.Cells(1, c), SearchIn, 0) 'Marking Col No. by matching Col Heads in SubSh
                                                                 'with that of MainBook
     If Not IsError(ColFnd) Then

      SubSh.Range(Cells(2, ColFnd).Address, SubSh.Cells(Rows.Count, ColFnd).End(xlUp).Address).Copy
      MainSh.Cells(Lr, c).PasteSpecial xlPasteValues             'OR xlPasteAll- Copying and pasting data in MainBook
      Application.CutCopyMode = False                            'Clearing ClipBoard

     End If
    
    Next
   
   End If
  
  Next
 
 Next

 Workbooks(FName).Close False                                    'Closing Extract sheet without saving it
 FName = Dir                                                     'Moving onto next Extract Sheet
 wb = wb + 1                                                     'Adding 1 to Extract workbook Counter
 Application.StatusBar = "Please Wait.... " & wb & " workbooks done..!"
 DoEvents                                                        'Updating the status bar
Loop
                                            
Application.ScreenUpdating = True
Application.StatusBar = ""
MsgBox "Finished", vbInformation
End Sub

Regards,
Vikas Gautam