Thanks Tom!!!!!

This code pulls data from specific cells and pupulates it into the
header and footer. It loops to each sheet so no matter how many sheets
are added they all get the same header and footer. It adjusts the font
size to 6pt for the footer and it turns off screen flicker.

Here is my code for all that might need it.....


Found in This Workbook

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim wkSht As Worksheet
Application.ScreenUpdating = False

For Each wkSht In ThisWorkbook.Worksheets

SetHeader wkSht

Next wkSht
Application.ScreenUpdating = True
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Dim wkSht As Worksheet
Application.ScreenUpdating = False

For Each wkSht In ThisWorkbook.Worksheets

SetHeader wkSht

Next wkSht
Application.ScreenUpdating = True
End Sub


Found in Module 1

Sub SetHeader(sh As Worksheet)
Dim lStr As String
Dim rStr As String
Dim dStr As String

With Worksheets("HeaderPage")
Application.ScreenUpdating = False
lStr = .Range("J2") & vbCr & .Range("J3") & vbCr &
Range("J4")
rStr = .Range("M2") & vbCr & .Range("M3") & vbCr & .Range("M4")
& vbCr & .Range("M5") & vbCr & .Range("M6")
dStr = "&6" & Range("W1") & vbCr & .Range("W2") & vbCr &
Range("W3") & vbCr & .Range("W4")
End With

With sh.PageSetup
LeftHeader = lStr
RightHeader = rStr
CenterFooter = dStr
End With

With ActiveSheet.PageSetup
TopMargin = Application.InchesToPoints(1.44)
BottomMargin = Application.InchesToPoints(1)

End With
End Sub


--
retseort
------------------------------------------------------------------------
retseort's Profile: http://www.excelforum.com/member.php...o&userid=24690
View this thread: http://www.excelforum.com/showthread...hreadid=480587