Auto Print

Afternoon all

I have a sheet that i have to print out every day for each memeber on my team, i have the template set out and a validation list in cell B18 with my staffs names in there, i have to drop down each name and press print.
So what i though is there must be a quicker way so i recorded a basic macro that repeated what i had done, problem there was it printed the same name (Validation name didnt move) so i tried thinking away around it and came up with this.

' test2 Macro
' Macro recorded 19/05/2009 by
'

'
    ActiveCell.FormulaR1C1 = "=R[-4]C[24]"
    Range("A1:O3").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[-3]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[-2]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=RC[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[1]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[2]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[3]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[4]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[5]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[6]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[7]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[8]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[9]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[10]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[11]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[12]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B5:C5").Select
    ActiveCell.FormulaR1C1 = "=R[13]C[24]"
    Range("B6").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("A6").Select
End Sub

This is not ideal and sometimes misses the first name off the list if another name is already in there.

Does anyone know a better way?

File is also attached