Consolidate Multiple Sheets into Master

Ok, I have a code that is working great, except for two things. I'd like to have the information on the Summary sheet start on Row 6, and have the names of the worksheets the info came from in Column A.

Code is as follows

Sub CombineAllSheets()
    Dim wsCopyTo As Worksheet
    Dim lngLastRow As Long
    Dim lngLoopCtr As Long
    Dim ws As Worksheet
    Dim lngLastRow2 As Long
    Sheets(1).Select
    Application.ScreenUpdating = False
    On Error Resume Next
    With Worksheets("Summary")
        If Err Then Worksheets.Add
        ActiveSheet.Name = "Summary"
        On Error GoTo 0
        Set wsCopyTo = Sheets("Summary")
    End With
    For Each ws In Sheets
        If ws.Name <> "Summary" Then
            lngLastRow2 = ws.Cells(Rows.Count, "B").End(xlUp).Row
            lngLastRow = wsCopyTo.Cells(Rows.Count, "B").End(xlUp).Row
            ws.Range("A6:K" & lngLastRow2).Copy wsCopyTo.Range("B" & lngLastRow + 1)
        End If

Next
    lngLastRow = wsCopyTo.Cells(Rows.Count, "B").End(xlUp).Row
    With wsCopyTo.Range("A6:K" & lngLastRow)
        .Columns.AutoFit
    End With
    For lngLoopCtr = lngLastRow To 2 Step -1
        If Cells(lngLoopCtr, "B") = "" Then
            Rows(lngLoopCtr).EntireRow.Delete
        End If
    Next lngLoopCtr
    Application.ScreenUpdating = True
End Sub

Also would like to have the Summary automatically update if I enter new data into the individual sheets, and to know, if I format the Summary sheet previously to running the macro, will it keep the formatting? (ex. hide columns etc)

I hope this is enough information, and any help will be greatly appreciated.

Thanks in advance!!

This line is copying

ws.Range("A6:K" & lngLastRow2).Copy wsCopyTo.Range("B" & lngLastRow + 1)

in to first empty column "B" of summary sheet, which is probably "B1". If you wish the copy to start at Rows 6, the easiset option would be to fill in data(Suspect heading) in "B1-B5", so that the next empyt would become B6.

Thank you, AB33!
That's perfect

Now I just need to figure out how to get the sheet names in column A, and I can probably clear all the data from "Summary" before re-running the macro to update, instead of having it go automatically.

Thanks again!

Slightly improved code

Sub CombineAllSheets()
    Dim ms As Worksheet, LRms As Long, lngLoopCtr As Long, ws As Worksheet, LR As Long
    Application.ScreenUpdating = False
    On Error Resume Next
        If Not Evaluate("ISREF(Summary!A1)") Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Summary"
        Else
        Sheets("Summary").UsedRange.Offset(5, 0).ClearContents
        End If
        Set ms = Sheets("Summary")
    For Each ws In Sheets
        If ws.Name <> "Summary" Then
            LR = ws.Cells(Rows.Count, "B").End(xlUp).Row
            LRms = ms.Cells(Rows.Count, "B").End(xlUp).Row
            ws.Range("A6:K" & LR).Copy ms.Range("B" & LRms + 1)
            Rng = ws.Cells(Rows.Count, 1).End(xlUp).Row - 1
            ms.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(Rng) = ws.Name
            
        End If

Next
    LRms = ms.Cells(Rows.Count, "B").End(xlUp).Row
    With ms.Range("A6:K" & LRms)
        .Columns.AutoFit
    End With
    For lngLoopCtr = LRms To 2 Step -1
        If Cells(lngLoopCtr, "B") = "" Then
            Rows(lngLoopCtr).EntireRow.Delete
        End If
    Next lngLoopCtr
    Application.ScreenUpdating = True
End Sub

Yes, I am afraid. I had a discussion on this forum regarding automatic update. It is not shared by the most experienced users of VBA

Sub CombineAllSheets()
    Dim ms As Worksheet, LRms As Long, lngLoopCtr As Long, ws As Worksheet, LR As Long
    Application.ScreenUpdating = False
    On Error Resume Next
    With Worksheets("Summary")
        If Err Then Worksheets.Add
        ActiveSheet.Name = "Summary"
        On Error GoTo 0
        Set ms = Sheets("Summary")
    End With
    For Each ws In Sheets
        If ws.Name <> "Summary" Then
            LR = ws.Cells(Rows.Count, "B").End(xlUp).Row
            LRms = ms.Cells(Rows.Count, "B").End(xlUp).Row
            ws.Range("A6:K" & LR).Copy ms.Range("B" & LRms + 1)
            Rng = ws.Cells(Rows.Count, 1).End(xlUp).Row - 1
            ms.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(Rng) = ws.Name
              
        End If

Next
    LRms = ms.Cells(Rows.Count, "B").End(xlUp).Row
    With ms.Range("A6:K" & LRms)
        .Columns.AutoFit
    End With
    For lngLoopCtr = LRms To 2 Step -1
        If Cells(lngLoopCtr, "B") = "" Then
            Rows(lngLoopCtr).EntireRow.Delete
        End If
    Next lngLoopCtr
    Application.ScreenUpdating = True
End Sub

Oh, you're a genius!

Unfortunately it seems to be over-copying the sheet names, and is copying row 5 from some sheets. Would it be easier if I uploaded a copy of my WB for you to see what I'm trying to do?

Yes, post the whole book

SO close! Now all I need is for it to not copy the 'empty' rows. I can't say enough how much I appreciate all your help. This would've taken me weeks to get this far :D

Thank you SO So much, that is perfect!

You are welcome!
Could you please close this thread as closed?