Print Macro Help

[jmendenhall1960]

I have a list of names (40) on Report sheet that I would like a macro to print starting at first name on Report sheet! A2 and place in cell B5 of certification sheet! then print the sheet next open Competency file Review sheet! then place the same name from Report sheet! A2 in cell B2 print the sheet then start all over with the name in the next row in Report sheet! cell A3 and place in cell B5 of certification sheet! then print the sheet then open Competency file Review sheet! then place the same name from Report sheet B2 in cell B2 (Competency file Review sheet!) print the sheet then start all over with next row (name) until no more names and end at the Report sheet!. The following is what I came up with when recording the macro but I know there is a shorter way (I just can't seem to figure it out). I only did two rows (names) and it is going to be a very long macro doing it my way. Thank you for looking and your help.

[Sub PrintCompetencyReport()
'
' PrintCompetencyReport Macro
' Prints Certification and Competency for each staff member
'
' Keyboard Shortcut: Ctrl+z
'
Sheets("Certification").Select
Range("B5").Select
ActiveCell.FormulaR1C1 = "=report!R[-3]C[-1]"
Range("B6").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Sheets("Competency File Review ").Select
Range("B2").Select
ActiveCell.FormulaR1C1 = "=report!RC[-1]"
Range("B3").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Sheets("Certification").Select
Range("B5").Select
ActiveCell.FormulaR1C1 = "=report!R[-2]C[-1]"
Range("B6").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Sheets("Competency File Review ").Select
Range("B2").Select
ActiveCell.FormulaR1C1 = "=report!R[1]C[-1]"
Range("B3").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Sheets("report").Select
End Sub]

 

[MARK858]

If I have read it right try the (untested) code below (are you sure about the space at the end of "Competency File Review " sheet?)

Sub testprint()
    Dim c As Range
    For Each c In Sheets("Reports").Range("A2:A" & Sheets("Reports").Range("A" & Rows.Count).End(xlUp).Row)
        c.Copy Sheets("Certification").Range("B5")
        c.Copy Sheets("Competency File Review ").Range("B2")
        Sheets(Array("Certification", "Competency File Review ")).PrintOut Copies:=1, Collate:=True
    Next
End Sub

 

[MARK858]

Actually as you probably only have to move values then the below should be more efficient.

Sub testprint()
    Dim c As Range
    For Each c In Sheets("Reports").Range("A2:A" & Sheets("Reports").Range("A" & Rows.Count).End(xlUp).Row)
        Sheets("Certification").Range("B5").Value = c.Value
        Sheets("Competency File Review ").Range("B2").Value = c.Value
        Sheets(Array("Certification", "Competency File Review ")).PrintOut Copies:=1, Collate:=True
    Next
    Sheets("Reports").Activate
End Sub

 

[jmendenhall1960]

Actually as you probably only have to move values then the below should be more efficient.

Sub testprint()
    Dim c As Range
    For Each c In Sheets("Reports").Range("A2:A" & Sheets("Reports").Range("A" & Rows.Count).End(xlUp).Row)
        Sheets("Certification").Range("B5").Value = c.Value
        Sheets("Competency File Review ").Range("B2").Value = c.Value
        Sheets(Array("Certification", "Competency File Review ")).PrintOut Copies:=1, Collate:=True
    Next
    Sheets("Reports").Activate
End Sub

Works great and thank you again. Saves me alot of time and I can't forget anyone this way.