Macro Help - To copy rows from multiple sheets to one sheet

[MacroNovice2]

Hi,

Would someone be able to help me with a macro please. I am looking for one to do the following:

I have a capacity planning spreadsheet with 14 sheets. 9 of the sheets are individual timing/task plan sheets for each member of the team. So apart from the data they have input into them the table/headings are the same. The first row where they will input data is no. 21 and the columns run from C to P.

I would like to copy all the data from each sheet into 1 sheet (Master Timing Plan) so I can see all tasks at once. And I want this to be updated every time they add/amend something on their timing plan.

Thank you

SB

 

[DanteAmor]

Put the following code in the events of your sheet

Right click the tab of the sheet "Master Timing Plan", select view code & paste the code into the window that opens up.
Each time you select the sheet, the macro will be activated and the sheet will be updated.

Change the names of the sheets in red by the names of your sheets to consider

Private Sub Worksheet_Activate()
    Dim sh As Worksheet, ws As Worksheet
    Dim u As Double
    
    Application.ScreenUpdating = False
    
    Set ws = Sheets("Master Timing Plan")
    ws.Rows("21:" & Rows.Count).ClearContents
    
    For Each sh In Sheets
        Select Case sh.Name
            Case [COLOR=#ff0000]"Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", _[/COLOR]
[COLOR=#ff0000]                 "Sheet6", "Sheet7", "Sheet8", "Sheet9"[/COLOR]
                 
                u1 = sh.Range("C" & Rows.Count).End(xlUp).Row
                u2 = ws.Range("C" & Rows.Count).End(xlUp).Row + 1
                sh.Range(sh.Cells(21, "C"), sh.Cells(u1, "P")).Copy
                ws.Cells(u2, "A").PasteSpecial xlValues
        End Select
    Next


    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    
    MsgBox "Updated Master Timing Plan"
End Sub

 

[MacroNovice2]

Thank you Dante Amor, this has worked really well. The only issue is that is it copying all the blank rows too. I could do with it looking to see if there is text in Column P and if there is only the coping that row. Are you able to amend it easily? Thanks SB

 

[DanteAmor]

Try this

Private Sub Worksheet_Activate()
    Dim sh As Worksheet, ws As Worksheet
    Dim u As Double
    
    Application.ScreenUpdating = False
    
    Set ws = Sheets("Master Timing Plan")
    ws.Rows("21:" & Rows.Count).ClearContents
    
    For Each sh In Sheets
        Select Case sh.Name
            Case "Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", _
                 "Sheet6", "Sheet7", "Sheet8", "Sheet9"
                 
                u1 = sh.Range("[COLOR=#0000ff]P[/COLOR]" & Rows.Count).End(xlUp).Row
                u2 = ws.Range("[COLOR=#0000ff]P[/COLOR]" & Rows.Count).End(xlUp).Row + 1
                sh.Range(sh.Cells(21, "C"), sh.Cells(u1, "P")).Copy
                ws.Cells(u2, "A").PasteSpecial xlValues
        End Select
    Next




    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    
    MsgBox "Updated Master Timing Plan"
End Sub

 

[MacroNovice2]

That has worked. Thank you very much.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.