Attribute VB_Name = "CombineSheets" ' Combines all worksheets into a single "Combined" sheet (assumes a header row on each). Sub CombineAllSheets() Dim ws As Worksheet, master As Worksheet Dim lastRow As Long, destRow As Long Application.ScreenUpdating = False On Error Resume Next Application.DisplayAlerts = False ThisWorkbook.Sheets("Combined").Delete Application.DisplayAlerts = True On Error GoTo 0 Set master = ThisWorkbook.Sheets.Add master.Name = "Combined" destRow = 1 For Each ws In ThisWorkbook.Worksheets If ws.Name <> "Combined" Then lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row If destRow = 1 Then ws.Rows(1).Copy master.Rows(1) destRow = 2 End If If lastRow > 1 Then ws.Range(ws.Rows(2), ws.Rows(lastRow)).Copy master.Cells(destRow, 1) destRow = destRow + (lastRow - 1) End If End If Next ws Application.ScreenUpdating = True MsgBox "Combined " & (destRow - 1) & " rows.", vbInformation End Sub