VBA Copy Paste Print Loop until empty

[ChaserQwerty]

Looking for VBA help to complete this task...

Goal is to copy and past from cells into a templet, print a defined area with this information then repeat until there is a blank cell.

The macro for doing 1 row of information looks like this...
How do I get the macro to loop until there is nothing in column A?

Row/Column	A	B	C	D
16	MN	SN	Code-128 MN	Code-128 SN
17	H8251235T0B375	123654789	ÑHÌrS7Í5T0B3750Ó	Ò,DVnÍ9mÓ
18	H8251235T0B376	123654789	ÑHÌrS7Í5T0B376=Ó	Ò,DVnÍ9mÓ
19	H8251235T0B377	123654789	ÑHÌrS7Í5T0B377JÓ	Ò,DVnÍ9mÓ

<colgroup><col><col><col><col><col></colgroup><tbody>
</tbody>

Sub Macro1()
' Macro1 Macro
Range("A17").Select
Selection.Copy
Range("A1:D2").Select
ActiveSheet.Paste
Range("B17").Select
Application.CutCopyMode = False
Selection.Copy
Range("A7:D8").Select
ActiveSheet.Paste
Range("C17").Select
Application.CutCopyMode = False
Selection.Copy
Range("A3:D4").Select
ActiveSheet.Paste
Range("D17").Select
Application.CutCopyMode = False
Selection.Copy
Range("A9:D10").Select
ActiveSheet.Paste
Range("A1:D10").Select
Application.CutCopyMode = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$D$10"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End Sub

 

[Fluff]

How about

Sub Macro1()

   Dim Cnt As Long
      
   ActiveSheet.PageSetup.PrintArea = "$A$1:$D$10"

   For Cnt = 17 To Range("A" & Rows.Count).End(xlUp).Row
      Range("A" & Cnt).Copy Range("A1:D2")
      Range("B" & Cnt).Copy Range("A7:D8")
      Range("C" & Cnt).Copy Range("A3:D4")
      Range("D" & Cnt).Copy Range("A9:D10")
      ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
         IgnorePrintAreas:=False
      Range("A1:D10").ClearContents
   Next Cnt
End Sub

 

[ChaserQwerty]

Awesome... Thanks for the help Fluff!!!

Had to adjust a few cells and added in a print quantity count.

 

[Fluff]

Glad to help & thanks for the feedback