Consolidation macro

[linesy]

Hi all,

I'm looking for a macro that will create a new worksheet "consolidated" and copy and paste all of the data (excluding duplicating the headings - headings row 2) from each sheet into the consolidated worksheet unless the value in A1 is blank.

Any help is greatly appreciated.

Linesy

 

[Michael M]

Maybe this
TRY IT ON A COPY FIRST

Sub MM1()
Dim lr As Long, lr2 As Long, ws As Worksheet
Application.ScreenUpdating = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Consolidated"
Sheets("Sheet1").Rows("2:2").Copy Destination:=Sheets("Consolidated").Rows("1:1")
lr2 = Sheets("Consolidated").Cells(Rows.Count, "A").End(xlUp).Row
For Each ws In Worksheets
    If ws.Name <> "Consolidated" Then
        ws.Activate
        If ws.Range("A1") <> "" Then
            lr = Cells(Rows.Count, "A").End(xlUp).Row
            Rows("3:" & lr).Copy Destination:=Sheets("Consolidated").Rows(lr2 + 1)
        End If
    End If
lr2 = Sheets("Consolidated").Cells(Rows.Count, "A").End(xlUp).Row
Next ws
Application.ScreenUpdating = True
End Sub

 

[JLGWhiz]

Try this

Sub cons()
Dim sh As Worksheet, conSh As Worksheet, lr As Long, lc As Long
Set conSh = Sheets.Add(After:=Sheets(Sheets.Count))
conSh.Name = "Consolidated"
    For Each sh In ThisWorkbook.Sheets
        If sh.Range("A1") <> "" And sh.Name <> conSh.Name Then
            lr = sh.Cells.Find("*", sh.Range("A1"), xlFormulas, xlPart, xlByRows, xlPrevious).Row
            lc = sh.Cells.Find("*", sh.Range("A1"), xlFormulas, xlPart, xlByColumns, xlPrevious).Column
            If conSh.Range("A1") = "" Then sh.Range("A1", sh.Cells(2, lc)).Copy conSh.Range("A1")
            sh.Range("A3", sh.Cells(lr, lc)).Copy conSh.Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    Next
End Sub

 

[linesy]

Thank you, these were both great solutions !! I appreciate your time

 

[Michael M]

Glad we could help....