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
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
15,094
Office Version
  1. 2010
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
15,094
Office Version
  1. 2010
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
15,094
Office Version
  1. 2010
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,168,109
Messages
5,857,443
Members
431,879
Latest member
KiwDaWabbit

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top