Results 1 to 7 of 7
  1. #1
    Silver Lounger
    Join Date
    Dec 2000
    Location
    California, USA
    Posts
    1,758
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Copy Entire Page Setup (XP: 03)

    Is it possible to copy the entire page setup of one sheet to another via code. That would include "Page, Margins, Header/Footer and Sheet".

    Thanks,
    John

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Copy Entire Page Setup (XP: 03)

    You can use a macro like this. Add or remove features as needed - if you type . somewhere between With and End With, IntelliSense will pop up a list of available properties.

    Sub TransferPageSetup()
    Dim ps1 As PageSetup
    Dim ps2 As PageSetup
    Set ps1 = Worksheets("Sheet1").PageSetup
    Set ps2 = Worksheets("Sheet2").PageSetup
    With ps2
    ' margins
    .TopMargin = ps1.TopMargin
    .LeftMargin = ps1.LeftMargin
    .BottomMargin = ps1.BottomMargin
    .RightMargin = ps1.RightMargin
    ' headers
    .LeftHeader = ps1.LeftHeader
    .CenterHeader = ps1.CenterHeader
    .RightHeader = ps1.RightHeader
    ' footers
    ' ...
    ' zoom
    .Zoom = ps1.Zoom
    ' black & white
    .BlackAndWhite = ps1.BlackAndWhite
    ' gridlines
    .PrintGridlines = ps1.PrintGridlines
    ' centering
    .CenterHorizontally = ps1.CenterHorizontally
    .CenterVertically = ps1.CenterVertically
    ' etc.
    End With
    End Sub

    Warning: modifying page setup in code is S L O O O O W !

  3. #3
    Silver Lounger
    Join Date
    Dec 2000
    Location
    California, USA
    Posts
    1,758
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Copy Entire Page Setup (XP: 03)

    Hans,

    Thank you,
    John

  4. #4
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: Copy Entire Page Setup (XP: 03)

    An alternate to going thru each of the pagesetup items is to:
    Copy the source sheet (which copies all the settings)
    Copy the contents of the destination cells in the the new copy
    delete the original destination
    rename the copy of the destination to the destination name

    WARNING: This will have problems if you have any links to destination sheet as this will "destroy them"

    You could move the cells instead of copying (to avoid destroying the links), but this will "destroy" some of the page setup setting (Print areas and print titles)

    You can use code like this:

    <pre>Option Explicit
    Sub CopyPageSetup(wksS As Worksheet, wksD As Worksheet)
    Dim wksTemp As Worksheet
    Dim sName As String
    sName = wksD.Name
    wksS.Copy before:=wksD
    Set wksTemp = ActiveSheet
    wksD.Cells.Copy wksTemp.Range("A1")
    Application.DisplayAlerts = False
    wksD.Delete
    Application.DisplayAlerts = True
    wksTemp.Name = sName
    Set wksTemp = Nothing
    End Sub</pre>


    And call it from code with line like (change the source and destination as desired)
    <pre>CopyPageSetup Worksheets(1), Worksheets(3)</pre>


    Steve

  5. #5
    Silver Lounger
    Join Date
    Dec 2000
    Location
    California, USA
    Posts
    1,758
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Copy Entire Page Setup (XP: 03)

    Hans/Steve,

    Thank you for your assistance. I have one more question.

    With Han's suggestion is it possible to copy the pagebreaks?

    Regards,
    John

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Copy Entire Page Setup (XP: 03)

    You need different code for page breaks:

    Sub TransferPagebreaks()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim hp1 As HPageBreak
    Dim vp1 As VPageBreak

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    For Each hp1 In ws1.HPageBreaks
    If hp1.Type = xlPageBreakManual Then
    ws2.HPageBreaks.Add Before:=ws2.Range(hp1.Location.Address)
    End If
    Next hp1

    For Each vp1 In ws1.VPageBreaks
    If vp1.Type = xlPageBreakManual Then
    ws2.VPageBreaks.Add Before:=ws2.Range(vp1.Location.Address)
    End If
    Next vp1
    End Sub

  7. #7
    Silver Lounger
    Join Date
    Dec 2000
    Location
    California, USA
    Posts
    1,758
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Copy Entire Page Setup (XP: 03)

    Hans,

    I didn't know if it was even possible.

    Thank you.
    John

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •