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

MacroNovice2

New Member
Joined
Feb 19, 2019
Messages
4
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
 

Some videos you may like

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
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

Code:
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

New Member
Joined
Feb 19, 2019
Messages
4
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

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
Try this

Code:
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,109,033
Messages
5,526,362
Members
409,697
Latest member
christopherlewis1620

This Week's Hot Topics

Top