Need Macro to combine multiple worksheets into one

Hi A. Patel,

Gee, this is almost identical to this thread I answered for psl this morning.

Let us know how this goes:

Option Explicit
Sub Macro1()

    'Written by Trebor76
    'Visit my website www.excelguru.net.au
    
    'Copy all records to next available row in Col. A of the 'wstResultsTab' tab from all
    'tabs except the 'wstResultsTab', 'Exclude this tab 1', 'Exclude this tab 2' and 'Exclude this tab 3' tabs.
    
    'http://www.excelforum.com/excel-programming-vba-macros/962868-need-macro-to-combine-multiple-worksheets-into-one.html

    Dim wstMySheet As Worksheet
    Dim rngCell As Range
    Dim lngEndRow As Long, _
        lngPasteRow As Long
    Dim wstResultsTab As Worksheet
    
    Set wstResultsTab = Sheets("Summary") 'Tab name for consolidated entries. Change to suit.
    
    Application.ScreenUpdating = False
    
    For Each wstMySheet In ThisWorkbook.Sheets
        If wstMySheet.Name <> wstResultsTab.Name And wstMySheet.Name <> "Exclude this tab 1" And wstMySheet.Name <> "Exclude this tab 2" And wstMySheet.Name <> "Exclude this tab 3" Then
            lngEndRow = wstMySheet.Cells(Rows.Count, "A").End(xlUp).Row
            For Each rngCell In Range(wstMySheet.Cells(2, "A"), wstMySheet.Cells(lngEndRow, "A"))
                lngPasteRow = wstResultsTab.Cells(Rows.Count, "A").End(xlUp).Row + 1
                Range(wstResultsTab.Cells(lngPasteRow, "A"), wstResultsTab.Cells(lngPasteRow, "D")).Value = Range(wstMySheet.Cells(rngCell.Row, "A"), wstMySheet.Cells(rngCell.Row, "D")).Value
            Next rngCell
        End If
    Next wstMySheet
    
    Application.ScreenUpdating = True
    
    MsgBox "All applicable rows have now been copied to the """ & wstResultsTab.Name & """ tab.", vbInformation, "Excel Guru"
    
    Set wstResultsTab = Nothing

End Sub

Regards,

Robert

Hi A.Patel,

See how this goes:

Option Explicit
Sub Macro1()

    'Written by Trebor76
    'Visit my website www.excelguru.net.au
    
    'Copy all records to next available row in Col. A of the 'wstResultsTab' tab from all
    'tabs except the 'wstResultsTab', 'Exclude this tab 1', 'Exclude this tab 2' and 'Exclude this tab 3' tabs.
    
    'http://www.excelforum.com/excel-programming-vba-macros/962868-need-macro-to-combine-multiple-worksheets-into-one.html

    Dim wstMySheet As Worksheet
    Dim rngCell As Range
    Dim lngEndRow As Long, _
        lngPasteRow As Long
    Dim wstResultsTab As Worksheet
    
    Set wstResultsTab = Sheets("Summary") 'Tab name for consolidated entries. Change to suit.
    
    Application.ScreenUpdating = False
    
    For Each wstMySheet In ThisWorkbook.Sheets
        If wstMySheet.Name <> wstResultsTab.Name And wstMySheet.Name <> "Exclude this tab 1" And wstMySheet.Name <> "Exclude this tab 2" And wstMySheet.Name <> "Exclude this tab 3" Then
            lngEndRow = wstMySheet.Cells(Rows.Count, "A").End(xlUp).Row
            lngPasteRow = wstResultsTab.Cells(Rows.Count, "A").End(xlUp).Row + 1
            Range(wstMySheet.Cells(2, "A"), wstMySheet.Cells(lngEndRow, "D")).Copy Destination:=wstResultsTab.Cells(lngPasteRow, "A")
        End If
    Next wstMySheet
    
    Application.ScreenUpdating = True
    
    MsgBox "All applicable rows have now been copied to the """ & wstResultsTab.Name & """ tab.", vbInformation, "Excel Guru"
    
    Set wstResultsTab = Nothing

End Sub

Regards,

Robert