Results 1 to 10 of 10
  1. #1
    Star Lounger
    Join Date
    Mar 2004
    Location
    Essex, England
    Posts
    93
    Thanks
    0
    Thanked 0 Times in 0 Posts

    set header and footer on created worksheet (2003)

    I have some code (manipulated from a previous post) that takes a single worksheet from a master workbook and exports it to a new workbook. It all works great except that the new worksheet revert back to portrait mode and loses my header and footer info.

    I would like the new workbook to be in Landscape mode, to fit to 1 page wide, with a header title and a date in the footer.
    Is there a way to add that request to the code below.

    Many Thanks
    Robert


    Public Sub SendToNewSheet()
    Dim I As Long
    Dim oNewWB As Workbook, oOldWB As Workbook
    Dim strFileName As String
    Application.ScreenUpdating = False
    Set oOldWB = ActiveWorkbook
    Set oNewWB = Workbooks.Add
    oOldWB.Activate
    Sheets("Report").Select
    Cells.Select
    Selection.Copy
    oNewWB.Worksheets("Sheet1").Paste Destination:=oNewWB.Worksheets("Sheet1").Range("A1 ")
    Application.CutCopyMode = False
    strFileName = ActiveSheet.Range("A2").Value
    strFileName = strFileName & " " & Format(Date, "yyyymmdd")
    Application.DisplayAlerts = False
    oNewWB.SaveAs Filename:=oOldWB.Path & "" & strFileName, FileFormat:=xlWorkbook
    oNewWB.Close
    Application.DisplayAlerts = True
    Set oNewWB = Nothing
    Application.ScreenUpdating = True
    End Sub

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

    Re: set header and footer on created worksheet (2003)

    Instead of creating a new workbook and copying all cells from the source sheet into the first sheet in the new workbook, you can copy the source sheet to a new workbook. This will preserve the page setup.

    Sub SendToNewSheet()
    Dim oOldWB As Workbook
    Dim oNewWB As Workbook
    Dim strFileName As String
    Application.ScreenUpdating = False
    Set oOldWB = ActiveWorkbook
    oOldWB.Worksheets("Report").Copy
    Set oNewWB = ActiveWorkbook
    strFileName = Range("A2").Value
    strFileName = strFileName & " " & Format(Date, "yyyymmdd")
    Application.DisplayAlerts = False
    oNewWB.SaveAs Filename:=oOldWB.Path & "" & strFileName
    oNewWB.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End Sub

  3. #3
    Star Lounger
    Join Date
    Mar 2004
    Location
    Essex, England
    Posts
    93
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: set header and footer on created worksheet (2003)

    Thanks Hans, that works great.

    I would also like to extend this code so as to loop through a pivot table to run the separate pages to put into the new workbooks. I have a code snippet for looping through a Pivot Table and after each loop I will need to run two macros. The first macro does some work re-engineering the data and then the second macro is your code below.
    I am struggling to combine the 3 bits of code. At the moment, I get a "Sub or function not defined error" on line 7. Have you any further advice please?


    Dim ws As Worksheet
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim pi As PivotItem
    Sheets("Pivot").Select
    Set ws = ActiveSheet
    Set pt = PivotTables(1)
    setpf = PivotFields
    ActiveSheet.PivotTables("PivotTable1").PivotCache. Refresh
    For Each pi In pf.PivotItems
    pf.CurrentPage = pi.Name
    Run ("mcrAfterPivotUpdate")
    Run ("Run_Button_Click")
    Next pi
    Set pi = Nothing
    Set pf = Nothing
    Set pt = Nothing
    Set ws = Nothing



    Thanks
    Robert

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

    Re: set header and footer on created worksheet (2003)

    The line

    setpf = PivotFields

    should probably be

    Set pf = pt.PivotFields

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

    Re: set header and footer on created worksheet (2003)

    BTW, you don't need to use (Application.)Run to call another macro such as mcrAfterPivotUpdate if it is in the same workbook, you can use

    Call mcrAfterPivotUpdate

    or even just

    mcrAfterPivotUpdate

  6. #6
    Star Lounger
    Join Date
    Mar 2004
    Location
    Essex, England
    Posts
    93
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: set header and footer on created worksheet (2003)

    Hans
    After your suggested code change it has still failed at the line above at :- Set pt = PivotTables(1)

    Regards
    Robert

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

    Re: set header and footer on created worksheet (2003)

    Try

    Dim ws As Worksheet
    Dim pt As PivotTable
    Dim pf As PivotField
    Dim pi As PivotItem
    Set ws = Sheets("Pivot")
    Set pt = ws.PivotTables(1)
    Set pf = pt.PivotFields("NameOfField")
    pt.PivotCache.Refresh
    For Each pi In pf.PivotItems
    pf.CurrentPage = pi.Name
    Call mcrAfterPivotUpdate
    Call Run_Button_Click
    Next pi
    Set pi = Nothing
    Set pf = Nothing
    Set pt = Nothing
    Set ws = Nothing

    You'll have to substitute the name of the relevant pivot field for NameOfField

  8. #8
    Star Lounger
    Join Date
    Mar 2004
    Location
    Essex, England
    Posts
    93
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: set header and footer on created worksheet (2003)

    Hans

    The macro passes the first loop OK but then it fails at "pf.CurrentPage = pi.Name" just before the first 'Call'. The message is runtime error 1004 (unable to set the default property of the Pivot Item class)
    In the code, if I run the mouse over the pf.CurrentPage it is set to the first 'Department' in the loop and pi.Name is set to the next 'Department' in the loop.


    Code Extract is :-
    .....
    .....
    Set pf = pt.PivotFields("Department")
    pt.PivotCache.Refresh
    For Each pi In pf.PivotItems
    pf.CurrentPage = pi.Name (Fails here)
    .....
    .....



    Regards
    Robert

    Robert

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

    Re: set header and footer on created worksheet (2003)

    Does that department still exist in the data? Excel doesn't always remove items from the PivotItems collection when you update the pivot table or pivot cache.
    See Excel -- Pivot Tables -- Clear Items for ways to delete unused items (or see <post:=219,148>post 219,148</post:>).

  10. #10
    Star Lounger
    Join Date
    Mar 2004
    Location
    Essex, England
    Posts
    93
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: set header and footer on created worksheet (2003)

    Hans,

    Yes that is the reason. I have now added the code snippet to the macro and everything works fine.
    Thank you very much for all your time.

    Regards
    Robert

Posting Permissions

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