Table Merge VBA Script

multi_table_merge.bas

Sub CreateMasterSheet(masterSheetName As String)
' This subroutine creates the Master sheet if we don't have one

Application.ScreenUpdating = False
Dim wrk As Workbook
Dim sheet As Worksheet
Dim masterSheet As Worksheet
Dim masterSheetExists As Boolean
masterSheetExists = False

Set wrk = ActiveWorkbook

For Each sheet In wrk.Worksheets
    If sheet.Name = masterSheetName Then
        masterSheetExists = True
        Exit For
    End If
Next sheet

If masterSheetExists = False Then
    Set masterSheet = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
    masterSheet.Name = masterSheetName
End If

Application.ScreenUpdating = True

End Sub

Sub UpdateMasterSheet(masterSheetName As String)
' Goes through each sheet in our workbook and copies their rows to our Master sheet

Application.ScreenUpdating = False
Dim wrk As Workbook
Dim sheet As Worksheet
Dim masterSheet As Worksheet
Dim rng As Range
Set wrk = ActiveWorkbook
Set masterSheet = wrk.Worksheets(masterSheetName)

For Each sheet In wrk.Worksheets
    If sheet.Index = wrk.Worksheets.Count Then
        Exit For
    End If
    ' Ignore a hypothetical hidden sheet
    If sheet.Name <> "Data - Do Not Edit" Then
        ' Copy from the source's second row to avoid grabbing headers
        Set rng = sheet.Range(sheet.Cells(2, 1), sheet.Cells(65536, 1).End(xlUp).Resize(, 256))
        ' Copy to the destination - starting at the second row so we can retain headers
        masterSheet.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
    End If
Next sheet

masterSheet.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Sub ClearMasterSheet(masterSheetName As String)
    ' Leave the first row so we can retain headers
    ' Use ClearContents to retain any cell formatting
    ' Adjust the Range if you add columns to your tables
    Worksheets(masterSheetName).Range("A2:H9999").ClearContents
End Sub

Sub RunMe()
    ' daviseford.com - By Davis E. Ford Jan. 2019'

    ' Adjust the masterSheetName if you want a different output sheet name
    Dim masterSheetName As String
    masterSheetName = "Merged Tables"

    ' Create the sheet, if needed
    Call CreateMasterSheet(masterSheetName)

    ' Clear out the existing sheet
    Call ClearMasterSheet(masterSheetName)

    ' Grab all data from all sheets
    Call UpdateMasterSheet(masterSheetName)
    
End Sub