create master "list" from multiple worksheets

[rameter]

I have a workbook that uses a template on several separate worksheets (the worksheets are differentiated by geographic area). The columns in each worksheet are identical, however the rows aren't. I'd like to create a combined list of the rows on a master sheet. For example columns include: name, city, Type, status, contact, notes, etc. I have 5 sheets with these same columns but the rows are unique (labeled by the Name column). I want a master sheet that collects the rows from each worksheet and lists them. From there I hope to sort or filter by the various columns. Make sense? It would be great if I could make it dynamic too. Is this possible?

 

[pboltonchina]

Try this on a copy of your data

Option Explicit

Sub ConsolidateSheets()
'Author:    Jerry Beaucaire
'Date:      6/26/2009
'Updated:   6/23/2010
'Merge all sheets in a workbook into one summary sheet (stacked)
'Data is sorted by a specific column name
Dim cs As Worksheet, WS As Worksheet
Dim LR As Long, NR As Long, sCol As Long
Dim sName As Boolean, SortStr As String
Application.ScreenUpdating = False

'From the headers in data sheets, enter the column title to sort by when finished
SortStr = "Invoice #"

'Add consolidation sheet if needed
If Not Evaluate("ISREF(Consolidate!A1)") Then _
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Consolidate"

'Option to add sheet names to consolidation report
sName = MsgBox("Add sheet names to consolidation report?", vbYesNo + vbQuestion) = vbYes

'Setup
Set cs = ActiveWorkbook.Sheets("Consolidate")
cs.Cells.ClearContents
NR = 1

'Process each data sheet
    For Each WS In Worksheets
        If WS.Name <> "Consolidate" Then
            LR = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
            'customize this section to copy what you need
            If NR = 1 Then      'copy titles and data to start the consolidation
                WS.Range("A1", WS.Cells(1, Columns.Count).End(xlToLeft)).Copy
                If sName Then
                    cs.Range("B1").PasteSpecial xlPasteAll
                Else
                    cs.Range("A1").PasteSpecial xlPasteAll
                End If
                NR = 2
            End If
            
            WS.Range("A2:BB" & LR).Copy     'copy data

            If sName Then       'paste and add sheet names if required
                cs.Range("B" & NR).PasteSpecial xlPasteValues
                cs.Range("A" & NR, cs.Range("B" & cs.Rows.Count).End(xlUp).Offset(0, -1)) = WS.Name
            Else
                cs.Range("A" & NR).PasteSpecial xlPasteValues
            End If
            
            NR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row + 1
        End If
    Next WS

'Sort
    LR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row
    On Error Resume Next
    sCol = cs.Cells.Find(SortStr, after:=cs.Range("A1"), LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column
    cs.Range("A1:BB" & LR).Sort key1:=cs.Cells(2, sCol + (IIf(sName, 1, 0))), Order1:=xlAscending, _
        Header:=xlYes, ordercustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Cleanup
    If sName Then cs.[A1] = "Sheet"
    cs.Rows(1).Font.Bold = True
    cs.Cells.Columns.AutoFit
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    cs.Activate
    Range("A1").Select
    Set cs = Nothing
End Sub

 

[John Davis]

I have a workbook that uses a template on several separate worksheets (the worksheets are differentiated by geographic area). The columns in each worksheet are identical, however the rows aren't. I'd like to create a combined list of the rows on a master sheet. For example columns include: name, city, Type, status, contact, notes, etc. I have 5 sheets with these same columns but the rows are unique (labeled by the Name column). I want a master sheet that collects the rows from each worksheet and lists them. From there I hope to sort or filter by the various columns. Make sense? It would be great if I could make it dynamic too. Is this possible?

Maybe something like this?

Sub rameter()
Dim i As Long
Dim lr As Long
Dim ws As Worksheet
Dim x As String


Sheets.Add.Name = "Master Sheet"

x = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")

For i = LBound(x) To UBound(x)

lr = Cells(Rows.Count, 1).End(3).Row

Range(Range("A"), Range("A" & lr)).EntireRow.Copy Sheets("Master Sheet").Range("A" & Rows.Count).End(xlUp)(2)

Next i


End Sub