How to consolidate Microsoft Excel Worksheets in VBA?

Below are the steps to consolidate Microsoft Excel worksheets in VBA :-

• Press Windows Logo Key ( ) + R to open Run Dialog box.
  
  
  
• Type Excel to open Microsoft Excel Application
  
  
  
• Press ALT + F11 (function key) to Open Visual Basic for Application Editor
  
  
  
• Select Insert from Menu bar then select Module from Pop up Window
  
  
  
• then Copy & Paste Below written code in the module
  
  
  
• Place Cursor any where in the code and click on run button (you can also press F5 to run this code).
  
  
  




VBA Code :

Option Explicit

Public Sub ConsolidateSheets()
Dim wrkBkDump, wrkBkNewDump As Workbook
Dim LastRow As Long, i As Long, FileDump

Application.DisplayAlerts = False
Application.ScreenUpdating = False

FileDump = Application.GetOpenFilename("Microsoft Excel workbook(*.xl*),(*.xl*)", MultiSelect:=False)

If FileDump <> False Then
    Set wrkBkDump = Application.Workbooks.Open(FileDump, ReadOnly:=True)

    Set wrkBkNewDump = Excel.Workbooks.Add
    With wrkBkNewDump
        '.Sheets(Array(1, 2)).Delete
        .Sheets(1).Name = "Dump"
    End With
    
    For i = 1 To wrkBkDump.Sheets.Count
        wrkBkDump.Worksheets(i).AutoFilterMode = False
        wrkBkDump.Worksheets(i).Range("A3").CurrentRegion.Copy
        
        With wrkBkNewDump.Worksheets("dump")
            LastRow = .Range("B1048576").End(xlUp).Row
            
            If LastRow <> 1 Then
                .Range("A" & LastRow + 1).PasteSpecial (xlPasteAll)
            Else
                .Range("A1").PasteSpecial (xlPasteAll)
            End If
            Application.CutCopyMode = False
        End With

    Next

    wrkBkNewDump.SaveAs (Replace(FileDump, ".", "_Copy."))
End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub