Merge Functions‎ > ‎

Sheets to 1 Sheet

PART 1 - All Sheets In Same Layout


Sample sheet for this macro:   SheetsTo1Sheet-ConsolidationMacros.xls

SPECIFICATIONS:

  1. Multiple sheets in the same workbook with the same layout
  2. On all sheets data titles are in row 1, data starts in row 2
  3. Copy all data in all sheets to a single consolidation sheet with data stacked and sorted
  4. Option to add which sheet each row of data came from
  5. Code to edit is highlighted in red

CODE

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 <> cs.Name 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, edit row as needed for source of titles

                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, edit as needed for the start row

            If sName Then       'paste and add sheet names if required
                cs.Range("B" & NR).PasteSpecial xlPasteValuesAndNumberFormats
                cs.Range("A" & NR, cs.Range("B" & cs.Rows.Count).End(xlUp).Offset(0, -1)) = ws.Name
            Else
                cs.Range("A" & NR).PasteSpecial xlPasteValuesAndNumberFormats
            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


PART 2 - All Sheet Columns In Different Layouts

Sample sheets for this macro:  ImportConsolidationMacro.zip

SPECIFICATIONS:

  1. Target workbook is laid out with the column headers in the order wanted
  2. Multiple sheets in the same source workbook with columns in randomized order
  3. On all sheets data titles are in row 1, data starts in row 2
  4. Copy all data in all sheets to a single consolidation sheet with data stacked and sorted
  5. Code to edit is highlighted

CODE

Option Explicit

Sub ConsolidateRandomColumns()
'Jerry Beaucaire   6/23/2010
'Open a source file and copy all the data from all sheets
'into this workbook matching the column headers in this workbook
Dim wsData  As Worksheet
Dim wsCons  As Worksheet
Dim wbSrc   As Workbook
Dim Col     As Long
Dim NumCols As Long
Dim ColFnd  As Long
Dim LastRow As Long
Dim NextRow As Long
Application.ScreenUpdating = False

'Setup - Report sheet
    Set wsCons = ThisWorkbook.Sheets("Consolidated Data")
    NumCols = wsCons.Range("1:1").SpecialCells(xlConstants).Columns.Count
    NextRow = wsCons.Range("A" & Rows.Count).End(xlUp).Row + 1

'Open the source data workbook
    Set wbSrc = Workbooks.Open("C:\2010\Source.xls")
    On Error Resume Next

'Loop each sheet and collect data from matching columns
    For Each wsData In wbSrc.Worksheets
        LastRow = wsData.Cells.Find("*", wsData.Cells(Rows.Count, Columns.Count), _
            SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For Col = 1 To NumCols
            ColFnd = wsData.Range("1:1").Find(wsCons.Cells(1, Col).Text, _
                wsData.Cells(1, Columns.Count), xlValues, xlWhole, _
                SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
            If ColFnd > 0 Then
                wsData.Range(wsData.Cells(2, ColFnd), wsData.Cells(LastRow, ColFnd)) _
                    .Copy wsCons.Cells(NextRow, Col)
                ColFnd = 0
            End If
        Next Col
        NextRow = wsCons.Range("A" & Rows.Count).End(xlUp).Row + 1
    Next wsData
   
'Cleanup
    wbSrc.Close False
    Set wsCons = Nothing
    Set wbSrc = Nothing
    Application.ScreenUpdating = True
End Sub




Nothing says "thanks" like a steak dinner!
PayPal - The safer, easier way to pay online!

Comments