How to add cell value in certain row in every print page's header

[tyruschen]

Hi,

My Excel file consists of many columns, with the first column serving as the print title column, and each subsequent column representing a separate task list for different order. I want to print each column as a separate page and have a specific row's cell value printed in the right header of each page.

For example, the table below has three columns for print, I want to print it with first page with right header printed "Apple", second one printed "Orange", and third with"Grape". How can I achieve this?
Thank you!

sample worklist.xls
	A	B	C	D
1	Print Title	Worklist#1	Worklist#2	Worklist#3
2	Order Number	71325 (2)	71325 (2)	71325 (2)
3	Worklist Number	71325-01	71325-02	71325-02
4	Fruit	Apple	Orange	Grape
5	Client	A	B	C
6	Price	$600	$800	$1,000
7
8	Quantity	6	10	10
Sheet1

 

[Wookiee]

I can't really test this out myself as my printer is mapped to an offsite location. But the code did appear to work when I tested before realizing that.

Sub Tyruschen()
'Crafted by Wookiee at MrExcel.com


Dim rngHeader   As Range
Dim rngLabel    As Range
Dim rngPrint    As Range
Dim rngWork1    As Range
Dim rngWork2    As Range
Dim rngWork3    As Range

'Update if your data extends beyond Row 8
Const LNGLAST As Long = 8

With ActiveSheet

  Set rngLabel = .Range("A1:A" & LNGLAST)
  Set rngWork1 = .Range("B1:B" & LNGLAST)
  Set rngWork2 = .Range("C1:C" & LNGLAST)
  Set rngWork3 = .Range("D1:D" & LNGLAST)
  

  Set rngHeader = rngWork1(4)
  Set rngPrint = Union(rngLabel, rngWork1)

  With .PageSetup
    
    .PrintArea = rngPrint.Address
    .CenterHeader = rngHeader

  End With

  ActiveWindow.SelectedSheets.PrintOut


  Set rngHeader = rngWork2(4)
  Set rngPrint = Union(rngLabel, rngWork2)

  With .PageSetup
    
    .PrintArea = rngPrint
    .CenterHeader = rngHeader

  End With

  ActiveWindow.SelectedSheets.PrintOut

  Set rngHeader = rngWork3(4)
  Set rngPrint = Union(rngLabel, rngWork3)

  With .PageSetup
    
    .PrintArea = rngPrint
    .CenterHeader = rngHeader

  End With

  ActiveWindow.SelectedSheets.PrintOut

End With

Set rngHeader = Nothing
Set rngLabel = Nothing
Set rngPrint = Nothing
Set rngWork1 = Nothing
Set rngWork2 = Nothing
Set rngWork3 = Nothing

End Sub

 

[Wookiee]

Oops. I forgot to include the .Address element to a few lines. Please try this version instead:

Sub Tyruschen()
'Crafted by Wookiee at MrExcel.com


Dim rngHeader   As Range
Dim rngLabel    As Range
Dim rngPrint    As Range
Dim rngWork1    As Range
Dim rngWork2    As Range
Dim rngWork3    As Range

'Update if your data extends beyond Row 8
Const LNGLAST As Long = 8

With ActiveSheet

  Set rngLabel = .Range("A1:A" & LNGLAST)
  Set rngWork1 = .Range("B1:B" & LNGLAST)
  Set rngWork2 = .Range("C1:C" & LNGLAST)
  Set rngWork3 = .Range("D1:D" & LNGLAST)
  

  Set rngHeader = rngWork1(4)
  Set rngPrint = Union(rngLabel, rngWork1)

  With .PageSetup
    
    .PrintArea = rngPrint.Address
    .CenterHeader = rngHeader

  End With

  ActiveWindow.SelectedSheets.PrintOut


  Set rngHeader = rngWork2(4)
  Set rngPrint = Union(rngLabel, rngWork2)

  With .PageSetup
    
    .PrintArea = rngPrint.Address
    .CenterHeader = rngHeader

  End With

  ActiveWindow.SelectedSheets.PrintOut

  Set rngHeader = rngWork3(4)
  Set rngPrint = Union(rngLabel, rngWork3)

  With .PageSetup
    
    .PrintArea = rngPrint.Address
    .CenterHeader = rngHeader

  End With

  ActiveWindow.SelectedSheets.PrintOut

End With

Set rngHeader = Nothing
Set rngLabel = Nothing
Set rngPrint = Nothing
Set rngWork1 = Nothing
Set rngWork2 = Nothing
Set rngWork3 = Nothing

End Sub

 

[tyruschen]

Oops. I forgot to include the .Address element to a few lines. Please try this version instead:

Thank you for your help!