Howdee Chevroyd
Yes, I do recognise the ditty, and I'm sorry I didn't get the gist of your problem before (not the being over the hill problem, it's too late for that)
This is a couple of pieces of code from the 12 October 2002 edition of ExcelTips so with all due consideration to them try it and see if it helps. I changed the first bit of code to just do headers.
The following two macros can be used to copy headers and footers
in one simple step.
All you need to do is display the source worksheet and use the GetHeaders macro. This macro copies the header and footer information to string variables. You can then display, in turn, each worksheet that you want to have the same header and footer and run the DoHeaders macro.
Code:
Option Explicit
Dim strHeadLeft As String
Dim strHeadCenter As String
Dim strHeadRight As String
Dim bGotHeaders As Boolean
Sub GetHeaders()
With ActiveSheet.PageSetup
strHeadLeft = .LeftHeader
strHeadCenter = .CenterHeader
strHeadRight = .RightHeader
bGotHeaders = True
End With
End Sub
Sub DoHeaders()
If bGotHeaders Then
With ActiveSheet.PageSetup
.LeftHeader = strHeadLeft
.CenterHeader = strHeadCenter
.RightHeader = strHeadRight
End With
Else
MsgBox "Select the sheet with the
headers you want to copy," _
& vbCrLf & "then run 'GetHeaders'",
vbExclamation, _
"No Headers In Memory"
End If
End Sub
You could even assign the macros to toolbar buttons, if desired, which can make them even handier for copying headers.
If you have quite a few worksheets and workbooks into which you want
the headers and footers copied, there is a different macro approach
you can use. The following macro will copy the headers and footers
from the active worksheet to all other worksheets in all other open
workbooks.
Code:
Sub CopyHeaderFooter()
Dim PS As PageSetup, WB As Workbook, WS As
Worksheet
Set PS = ActiveSheet.PageSetup
For Each WB In Workbooks
For Each WS In WB.Worksheets
With WS.PageSetup
.LeftHeader = PS.LeftHeader
.CenterHeader = PS.CenterHeader
.RightHeader = PS.RightHeader
.LeftFooter = PS.LeftFooter
.CenterFooter = PS.CenterFooter
.RightFooter = PS.RightFooter
End With
Next
Next
End Sub
In other words, if you want to copy headers and footers from the
current worksheet to 150 other worksheets spread across 15 different
workbooks, all you need to do is open the 15 workbooks at the same
time, display the source worksheet, and run the macro
Good Luck
anvil19
