Macro to consolidated all data from different sheets to summary sheet in the same workbook

[rochakmehta90]

Hi All,

I need macro to copy data from all sheets to one summary sheet already created in the same workbook.

Like I have around 50 different sheets from which I have to copy data in to summary sheet one by one.

I have attached my sample workbook and also wrote some guide points for your understanding....

Thank you in advance...

[oeldere]

Run this macro below in the file.

Sub integratie_Oeldere_revisted_vs2()

See the attached file for the result.

[oeldere]

With the help of AB33 (AB33 thanks for that ) you get the revisted code, in the attached file.

You find the code here:

Sub integratie_Oeldere_revisted_vs2()

Dim wsTest As Worksheet

'check if sheet "Consolidated" already exist

Const strSheetName As String = "Consolidated"
 
Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
 
If wsTest Is Nothing Then
    Worksheets.Add.Name = strSheetName
End If

With Sheets("Consolidated")
    .UsedRange.ClearContents
    .Range("A1:G1").Value = Array("sheet", "Year", "Month", "Project Leader", "Project Code", "Target alloted", "target covered")
    For Each sh In Sheets
        With sh
            If .Name <> "Consolidated" And .Name <> "Summary" Then
                Rng = .Cells.Find("*", , , , xlByRows, xlPrevious).Row - 1
                NR = Sheets("Consolidated").Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
                If Rng > 0 Then
                    Sheets("Consolidated").Cells(NR, 1).Resize(Rng) = .Name
                    Sheets("Consolidated").Cells(NR, 2).Resize(Rng, 6) = .Range("A2").Resize(Rng, 6).Value
                End If
            End If
        End With
    Next

    .Columns("A:Z").EntireColumn.AutoFit
End With
End Sub

[rochakmehta90]

Thank you oeldere for the help....

[oeldere]

Thanks for the reply.

Glad i could help.

And did it work for you?

[rochakmehta90]

Yes its working...

But I haven' tried on my mega sheet...I will have chance to try it on 20th..and let you know about it...

Thank you once again...