On Aug 19, 9:16*pm, pano wrote:
Stefan this is ok, but it prints worksheets 1,3,6 etc I want it to
print pages 1,3,6 on worksheet Day1

Any help appreciated...

Thanks Stephen

Sub Front1()
'Day 1
Application.ScreenUpdating = False
If WorksheetFunction.CountBlank( _
Sheets("Day1").Range("AK5:AK40")) = 36 Then
arr = Array(1, 3, 6)
Else
arr = Array(1, 3, 5, 6)
End If
For Each sh In Sheets(arr)
sh.PageSetup.CenterHeader = "page " & sh.Index
sh.PrintOut Copies:=1, Collate:=True
Next
Sheets("PrintMenu").Select
Application.ScreenUpdating = True
End Sub

different positions are possible: left/center/rightheader and footer.

stefan

Sub Front1()
'Day 1
Application.ScreenUpdating = False
If WorksheetFunction.CountBlank(Sheets("Day1").Range( "AK5:AK40"))
= 36 Then
arr = Array(1, 3, 6)
Else
arr = Array(1, 3, 5, 6)
End If
For sh = LBound(arr) To UBound(arr)
Sheets("Day1").PageSetup.CenterHeader = "page " & sh
Sheets("Day1").PrintOut From:=arr(sh), to:=arr(sh), Copies:=1,
Collate:=True
Next
Application.ScreenUpdating = True
Sheets("PrintMenu").Select
End Sub
Problem Solved thanks to PHIL

Sub Front1()
'Day 1
Application.ScreenUpdating = False
If WorksheetFunction.CountBlank(Sheets("Day1").Range( "AK5:AK40"))
= 36 Then
arr = Array(1, 3, 6)
Else
arr = Array(1, 3, 5, 6)
End If
For sh = LBound(arr) To UBound(arr)
Sheets("Day1").PageSetup.CenterHeader = "page " & sh
Sheets("Day1").PrintOut From:=arr(sh), to:=arr(sh), Copies:=1,
Collate:=True
Next
Application.ScreenUpdating = True
Sheets("PrintMenu").Select
End Sub