Macro Copy Main page to all worksheets

[dawnwong77]

I created a spreadsheet where I extract information from the main tab to multiple tabs based on customer number. I need to now add a header from the main sheet to all other sheets and having a hard time with a macro that will do this.

I need to Copy cells A1-M5 from tab Aging and paste to all other worksheets not Aging
Any assistance is appreciated

 

[mse330]

Welcome to board

Try the below code

Sub CopyHeader()

Dim ws As Worksheet

For Each ws In Worksheets
    If ws.Name <> "Aging" Then
        ws.Range("A1:M5").Value = Sheets("Aging").Range("A1:M5").Value
    End If
Next ws

End Sub

 

[JoeMo]

I created a spreadsheet where I extract information from the main tab to multiple tabs based on customer number. I need to now add a header from the main sheet to all other sheets and having a hard time with a macro that will do this.

I need to Copy cells A1-M5 from tab Aging and paste to all other worksheets not Aging
Any assistance is appreciated

Where do you want the copied data to be pasted on the other sheets?

 

[dawnwong]

Sorry not letting me log in with original Login info. I need to paste data to the same area

 

[dawnwong]

Thanks this works but does not paste the picture included in the range or the formatting can this be added?

 

[mse330]

Thanks this works but does not paste the picture included in the range or the formatting can this be added?

How about this ?

Sub CopyHeader()

Dim ws As Worksheet

For Each ws In Worksheets
    If ws.Name <> "Aging" Then
        Sheets("Aging").Range("A1:M5").Copy
        With ws
            .Range("A1").Select
            .Paste
        End With
    End If
Next ws

End Sub

 

[dawnwong]

How about this ?

Sub CopyHeader()

Dim ws As Worksheet

For Each ws In Worksheets
    If ws.Name <> "Aging" Then
        Sheets("Aging").Range("A1:M5").Copy
        With ws
            .Range("A1").Select
            .Paste
        End With
    End If
Next ws

End Sub

I get a range error

 

[mse330]

I get a range error

Yeah you need to activate the sheet in order to select a range within the sheet ... Try the below revised code

Sub CopyHeader()

Dim ws As Worksheet

For Each ws In Worksheets
    If ws.Name <> "Aging" Then
        Sheets("Aging").Range("A1:M5").Copy
        With ws
            .Activate
            .Range("A1").Select
            .Paste
        End With
    End If
Next ws

End Sub

This may not be the "best" way to do it but is working for me to copy the pictures as well

 

[dawnwong]

Yeah you need to activate the sheet in order to select a range within the sheet ... Try the below revised code

Sub CopyHeader()

Dim ws As Worksheet

For Each ws In Worksheets
    If ws.Name <> "Aging" Then
        Sheets("Aging").Range("A1:M5").Copy
        With ws
            .Activate
            .Range("A1").Select
            .Paste
        End With
    End If
Next ws

End Sub

This may not be the "best" way to do it but is working for me to copy the pictures as well

Thanks that works any chance you can help with adding in some page formatting
I want to repeat rows 1:5 on each page and sent to Landscape fitted to one page wide no setting on tall

THanks alot

 

[mse330]

You are welcome. Try the below code, this should take care of the other items you've requested

Sub CopyHeader()

Application.ScreenUpdating = False

Dim CurrWs As Worksheet, Cell As Range
    Set CurrWs = ActiveSheet
    Set Cell = ActiveCell

Dim ws As Worksheet, CNT As Single

For Each ws In Worksheets
    If ws.Name <> "Aging" Then
        CNT = CNT + 1
        Sheets("Aging").Range("A1:M5").Copy
        With ws
            .Activate
            .Range("A1").Select
            .Paste
            .PageSetup.FitToPagesWide = 1
            .PageSetup.FitToPagesTall = False
            .PageSetup.PrintTitleRows = "$1:$5"
            .PageSetup.Orientation = xlLandscape
            .Range("A1").Select
        End With
    End If
Next ws

CurrWs.Activate
Cell.Select

MsgBox "Task completed for all " & CNT & " sheets", vbInformation

Application.ScreenUpdating = True

End Sub