Macro to combine 4 worksheets into one worksheet

[llangid]

I have a workbook with 8 worksheets in it and I need to be able to combine 4 of the worksheets into one worksheet. Each worksheet has a name other than Sheet1, Sheet2 and so on. All four worksheets have the same number of columns but have a different number of rows in each. The number of rows in each worksheet is dynamic. Below is some code that I have adapted from combining 2 worksheets together (the code for just combining two worksheets together works great). I have been able to get it to only combine two of the four worksheets that I need. I am sure that I am missing something simple and would appreciate it if someone would be able to show me what it is that i am missing to make this macro combine all four worksheets?

Sub Combine_Four_Tabs()

Dim lngLastRow As Long

lngLastRow = Sheets("Friends").Range("A65536").End(xlUp).Row

If lngLastRow > 1 Then
Sheets("Friends").Range("A2:AN" & lngLastRow).ClearContents
End If

lngLastRow = Sheets("Ned").Range("A65536").End(xlUp).Row
Sheets("Ned").Range("A2:AN" & lngLastRow).Copy Sheets("Friends").Range("A2")

lngLastRow = Sheets("Sam").Range("A65536").End(xlUp).Row
Sheets("Sam").Range("A2:AN" & lngLastRow).Copy
Sheets("Friends").Select

lngLastRow = Sheets("John").Range("A65536").End(xlUp).Row
Sheets("John").Range("A2:AN" & lngLastRow).Copy
Sheets("Friends").Select

lngLastRow = Sheets("Fred").Range("A65536").End(xlUp).Row
Sheets("Fred").Range("A2:AN" & lngLastRow).Copy
Sheets("Friends").Select

Range("A65536").End(xlUp).Offset(1, 0).Select

ActiveSheet.Paste
Application.CutCopyMode = False

Columns("A:A").Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select

End Sub

Thanks in advance for your help.

 

[jbeaucaire]

How about this:

Option Explicit

Sub Combine_Four_Tabs()
Dim LR As Long, sht As Worksheet

With Sheets("Friends")
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    If LR > 1 Then .Range("A2:AN" & LR).ClearContents
    
    For Each sht In Sheets(Array("Ned", "Sam", "John", "Fred"))
        LR = sht.Range("A" & sht.Rows.Count).End(xlUp).Row
        sht.Range("A2:AN" & LR).Copy .Range("A" & .Rows.Count).End(xlUp).Offset(1)
    Next sht

    .Columns("A:A").Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    .Range("A1").Select
End With

End Sub

 

[llangid]

jbeaucaire

That works great. I forgot to add that I would like the first worksheet that gets copied takes row 1 with it. None of the others will need to because they all have the same first row.

Thanks

 

[jbeaucaire]

The macro as is appears to "keep" the headers in row 1 already. Why isn't that sufficient? If the headers are missing, add them one time before you start using this macro.

 

[llangid]

I will need to manual add the first row before I use the macro until I can figure out how to get it do it. I ran it several times and it starts at row two but doesn't add the first row.

Thanks for your help jbeaucaire it is greatly appreciated.

 

[jbeaucaire]

Option Explicit

Sub Combine_Four_Tabs()
Dim LR As Long, sht As Worksheet

With Sheets("Friends")
    NR = .Range("A" & .Rows.Count).End(xlUp).Row
    If NR > 1 Then
        .Range("A2:AN" & LR).ClearContents
        NR = 2
    End If
    
    For Each sht In Sheets(Array("Ned", "Sam", "John", "Fred"))
        LR = sht.Range("A" & sht.Rows.Count).End(xlUp).Row
        If NR = 1 Then
            sht.Range("A1:AN" & LR).Copy .Range("A" & NR)
        Else
            sht.Range("A2:AN" & LR).Copy .Range("A" & NR)
        End If
        NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    Next sht

    .Columns("A:A").Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    .Range("A1").Select
End With

End Sub

 

[llangid]

Jerry

That works perfectly thank you so much I really appreciate your time and help.

Larry