CODEWITHSUNDEEP
excelvba
Terry
Terry

Reputation: 61

How to copy the page setup from worksheets to another using VBA

How can I copy the page setup, including the RightHeaderPicture from worksheet to another using VBA? Can someone help me here? Regards, Antony Terrence

Upvotes: 2

Views: 5850

Answers (2)

James Wolfe
James Wolfe

Reputation: 151

Based on barryleajo's answer, I came up with this code:

(The commented areas caused runtime errors)

Sub copyPageSetup(fromSheet, toSheet)
With toSheet.PageSetup
    .AlignMarginsHeaderFooter = fromSheet.PageSetup.AlignMarginsHeaderFooter
'    .Application = fromSheet.PageSetup.Application
    .BlackAndWhite = fromSheet.PageSetup.BlackAndWhite
    .BottomMargin = fromSheet.PageSetup.BottomMargin
    .CenterFooter = fromSheet.PageSetup.CenterFooter
'   .CenterFooterPicture = fromSheet.PageSetup.CenterFooterPicture
    .CenterHeader = fromSheet.PageSetup.CenterHeader
'   .CenterHeaderPicture = fromSheet.PageSetup.CenterHeaderPicture
    .CenterHorizontally = fromSheet.PageSetup.CenterHorizontally
    .CenterVertically = fromSheet.PageSetup.CenterVertically
'   .Creator = fromSheet.PageSetup.Creator
    .DifferentFirstPageHeaderFooter = fromSheet.PageSetup.DifferentFirstPageHeaderFooter
    .Draft = fromSheet.PageSetup.Draft
'    .EvenPage = fromSheet.PageSetup.EvenPage
'    .FirstPage = fromSheet.PageSetup.FirstPage
    .FirstPageNumber = fromSheet.PageSetup.FirstPageNumber
    .FitToPagesTall = fromSheet.PageSetup.FitToPagesTall
    .FitToPagesWide = fromSheet.PageSetup.FitToPagesWide
    .FooterMargin = fromSheet.PageSetup.FooterMargin
    .HeaderMargin = fromSheet.PageSetup.HeaderMargin
    .LeftFooter = fromSheet.PageSetup.LeftFooter
'    .LeftFooterPicture = fromSheet.PageSetup.LeftFooterPicture
    .LeftHeader = fromSheet.PageSetup.LeftHeader
'    .LeftHeaderPicture = fromSheet.PageSetup.LeftHeaderPicture
    .LeftMargin = fromSheet.PageSetup.LeftMargin
    .OddAndEvenPagesHeaderFooter = fromSheet.PageSetup.OddAndEvenPagesHeaderFooter
    .Order = fromSheet.PageSetup.Order
    .Orientation = fromSheet.PageSetup.Orientation
'    .Pages = fromSheet.PageSetup.Pages
    .PaperSize = fromSheet.PageSetup.PaperSize
'    .Parent = fromSheet.PageSetup.Parent
    .PrintArea = fromSheet.PageSetup.PrintArea
    .PrintComments = fromSheet.PageSetup.PrintComments
    .PrintErrors = fromSheet.PageSetup.PrintErrors
    .PrintGridlines = fromSheet.PageSetup.PrintGridlines
    .PrintHeadings = fromSheet.PageSetup.PrintHeadings
    .PrintNotes = fromSheet.PageSetup.PrintNotes
    .PrintQuality = fromSheet.PageSetup.PrintQuality
    .PrintTitleColumns = fromSheet.PageSetup.PrintTitleColumns
    .PrintTitleRows = fromSheet.PageSetup.PrintTitleRows
    .RightFooter = fromSheet.PageSetup.RightFooter
'    .RightFooterPicture = fromSheet.PageSetup.RightFooterPicture
    .RightHeader = fromSheet.PageSetup.RightHeader
'    .RightHeaderPicture = fromSheet.PageSetup.RightHeaderPicture
    .RightMargin = fromSheet.PageSetup.RightMargin
    .ScaleWithDocHeaderFooter = fromSheet.PageSetup.ScaleWithDocHeaderFooter
    .TopMargin = fromSheet.PageSetup.TopMargin
    .Zoom = fromSheet.PageSetup.Zoom
    End With
End Sub

Upvotes: 5

barryleajo
barryleajo

Reputation: 1952

A bit bare-bones but you will get the idea by the time you have finished!

Apparently there is no easy way to copy the PageSetup object in its entirety so, assuming the workbook is open try the following:

Sub cpyPS()
Dim wsFrom As Worksheet, wsTO As Worksheet

Set wsFrom = Sheets("From")
Set wsTO = Sheets("To")

    With wsTO.PageSetup
        'there are nearly 50 properties
        .AlignMarginsHeaderFooter = wsFrom.PageSetup.AlignMarginsHeaderFooter
        .BlackAndWhite = wsFrom.PageSetup.BlackAndWhite
        .BottomMargin = wsFrom.PageSetup.BottomMargin
        '
        '
        .LeftMargin = wsFrom.PageSetup.LeftMargin
        '
        '
        .Orientation = wsFrom.PageSetup.Orientation
        '
        '
        .PaperSize = wsFrom.PageSetup.PaperSize

        .RightHeaderPicture.Filename = wsFrom.PageSetup.RightHeaderPicture.Filename
        .RightMargin = wsFrom.PageSetup.RightMargin
        '
        '
        .TopMargin = wsFrom.PageSetup.TopMargin
        '
        '
        .Zoom = wsFrom.PageSetup.Zoom
    End With

End Sub

The full list of properties to consider is provided here.

Never mind, perhaps write it once as a function and post back for all to use?

You could always copy the whole sheet and rename it if this is doable for you. The properties will be 'taken across' as it were.

Upvotes: 3

Related Questions