So I have a workbook with multiple sheets. All contain the same columns but just different categorical data. I want to grab all the data from those sheets and display/populate to a master sheet in the workbook.

I have tried different methods, but none of them are dynamic. The amount of data can be changed ( /-, either more rows or less rows) in each sheet. Each method I have found seems to be a static solution.

One example is to use the Consolidate option under the data tab, and add the respective reference/range for each sheet you would like to add (not dynamic).

Another option I found was a VBA macro, which populates the headers over and over, which I do not want to happen either, I want them all under the same header (Since the columns are already the same)

Sub Combine()
'UpdatebyExtendoffice20180205
    Dim I As Long
    Dim xRg As Range
    Worksheets.Add Sheets(1)
    ActiveSheet.Name = "Combined"
   For I = 2 To Sheets.Count
        Set xRg = Sheets(1).UsedRange
        If I > 2 Then
            Set xRg = Sheets(1).Cells(xRg.Rows.Count   1, 1)
        End If
        Sheets(I).Activate
        ActiveSheet.UsedRange.Copy xRg
    Next
End Sub

Is this achievable?

Sheet 1

Sheet 2

Master Sheet Should Be:

But actually returns the following:

Will this constantly run each time the workbook is closed/opened/updated if it is a macro enabled workbook?

CodePudding user response：

Consolidate All Worksheets

• It is assumed that the Combined worksheet already exists with at least the headers which will stay intact.
• To make it more efficient, only values are copied (no formats or formulas).
• It will utilize the Worksheet Activate event: each time you activate (select) the combined worksheet, the data will automatically be updated.

Sheet Module of the Combined worksheet e.g. Sheet10(Combined)

Option Explicit

Private Sub Worksheet_Activate()
    CombineToMaster
End Sub

Standard Module e.g. Module1

Option Explicit

Sub CombineToMaster()
    
    Const dName As String = "Combined"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    
    Dim drrg As Range
    
    With dws.UsedRange
        If .Rows.Count = 1 Then
            Set drrg = .Offset(1)
        Else
            .Resize(.Rows.Count - 1).Offset(1).Clear
            Set drrg = .Resize(1).Offset(1)
        End If
    End With
    
    Dim sws As Worksheet
    Dim srg As Range
    Dim drg As Range
    Dim rCount As Long
    
    For Each sws In wb.Worksheets
        If sws.Name <> dName Then
            With sws.UsedRange
                rCount = .Rows.Count - 1
                If rCount > 0 Then
                    Set srg = .Resize(rCount).Offset(1)
                    drrg.Resize(rCount).Value = srg.Value
                    Set drrg = drrg.Offset(rCount)
                End If
            End With
        End If
    Next sws
    
End Sub

CodePudding user response：

VBA Solution

Sub Combine()
    
    Dim wsCombine  As Worksheet: Set wsCombine = GetSheetCombine
    Dim dataSheets As Collection: Set dataSheets = GetDataSheets
    
    ' Copy Header
    dataSheets.Item(1).UsedRange.Rows(1).Copy
    wsCombine.Range("A1").PasteSpecial xlPasteAll
    wsCombine.Range("A1").PasteSpecial xlPasteColumnWidths
    Application.CutCopyMode = False
    
    ' Copy data
    Dim rngDest As Range: Set rngDest = wsCombine.Range("A2")
    Dim srcRng  As Range
    Dim ws      As Worksheet
    
    For Each ws In dataSheets
        ' Drop header row
        With ws.UsedRange
            Set srcRng = .Offset(1, 0).Resize(.Rows.Count - 1)
        End With
        srcRng.Copy rngDest
        Set rngDest = rngDest.Offset(srcRng.Rows.Count)
    Next ws
    Application.CutCopyMode = False
    
    MsgBox "Done!", vbInformation
    
End Sub

Private Function GetSheetCombine() As Worksheet
    
    Dim ws As Worksheet
    With Worksheets
        On Error Resume Next
        Set ws = .Item("Combine")
        On Error GoTo 0
        If ws Is Nothing Then
            Set ws = .Add(Before:=.Item(1))
            ws.Name = "Combine"
        Else
            ws.Cells.Clear ' clear any existing data
        End If
    End With
    Set GetSheetCombine = ws
    
End Function

Private Function GetDataSheets() As Collection

    Dim Result As New Collection
    Dim ws     As Worksheet
    For Each ws In Worksheets
        If ws.Name <> "Combine" Then Result.Add ws
    Next ws
    Set GetDataSheets = Result
    
End Function

As to your question "Will this run every time macro enabled workbook is open?".

No. You will need to put this in a VBA module and run it every time you need, via the Macro dialog (View->Macros), or link a button to it.