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?



[TABLE="width: 776"]
<colgroup><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Row/Column[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C [/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD]MN[/TD]
[TD]SN[/TD]
[TD]Code-128 MN[/TD]
[TD]Code-128 SN[/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]H8251235T0B375[/TD]
[TD]123654789[/TD]
[TD]ÑHÌrS7Í5T0B3750Ó[/TD]
[TD]Ò,DVnÍ9mÓ[/TD]
[/TR]
[TR]
[TD]18[/TD]
[TD]H8251235T0B376[/TD]
[TD]123654789[/TD]
[TD]ÑHÌrS7Í5T0B376=Ó[/TD]
[TD]Ò,DVnÍ9mÓ[/TD]
[/TR]
[TR]
[TD]19[/TD]
[TD]H8251235T0B377[/TD]
[TD]123654789[/TD]
[TD]ÑHÌrS7Í5T0B377JÓ[/TD]
[TD]Ò,DVnÍ9mÓ[/TD]
[/TR]
</tbody>[/TABLE]




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