getting MACRO to loop until cell is empty

I have created a MACRO that copies data from sheet2 A1 and pastes in in sheet1 range - "gunner". This causes changes in sheet3. The MACRO copies the info from sheet3 into a batch file and then it runs the batch file. The batch file goes to the folder named and creates a ZIP file.

Sheet2, column A is a list of file folders that need to be compressed. It is a large and changing list - ergo the MACRO.

I would like the MACRO to go through the process that I have outlined, then go back to sheet2, take the new entry and start the process over again, until column A is empty.

A long and drawn out way of saying that I need a "do loop", but I thought the more info I provide, the more assistance can be returned.

My code (sloppy and encumbered) is

Sub zip_it()
  
     Sheets("Sheet1").Select
    Range("gunner").Select
    Selection.ClearContents
   
    Sheets("Sheet2").Select
    Range("A1").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Sheets("Sheet1").Select
    Range("gunner").Select
    ActiveSheet.Paste
    
    Sheets("Sheet2").Select
     Range("A1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp

txt = "d:/testit.bat"
Open "d:/testit.bat" For Output As #1

Sheets("Sheet3").Select
Set rng = Range(Range("A1:a22"), _
   Cells(Rows.Count, 1).End(xlUp))
For Each cell In rng
 Print #1, cell.Text
 Print #1, cell.Offset(0, 1).Text
 Print #1,
Next

   Close #1


Call Shell("d:\testit.bat", vbNormalFocus)
 
 
End Sub

Option Explicit
Sub zip_it()

'I have created a MACRO that copies data from "sheet2 A1" and pastes
'in in sheet1 range - "gunner". This causes changes in sheet3.
'The MACRO copies the info from sheet3 into a batch file and then
'it runs the batch file. The batch file goes to the folder named
'and creates a ZIP file.

'"Sheet2, column A" is a list of file folders that need to be compressed.
'It is a large and changing list - ergo the MACRO.
'I would like the MACRO to go through the process that I have outlined,
'then go back to sheet2, take the new entry and start the process over
'again, until column A is empty.
'=========================================================================
    Dim ListOfFolders   As Range, _
        Rng             As Range, _
        Foldername      As Range, _
        TestCell        As Range, _
        BatName         As String, _
        SHEET1          As Worksheet, _
        SHEET2          As Worksheet, _
        SHEET3          As Worksheet

    BatName = "d:/testit.bat"
    
    Set SHEET1 = Worksheets("Sheet1")
    Set SHEET2 = Worksheets("Sheet2")
    Set SHEET3 = Worksheets("Sheet3")
    
    Set ListOfFolders = SHEET2.Range("A1:A" & SHEET2.Cells(Rows.Count, "A").End(xlUp).Row)
    Set Rng = SHEET3.Range("A1:A" & SHEET3.Cells(Rows.Count, "A").End(xlUp).Row)
    
    For Each Foldername In ListOfFolders
        SHEET1.Range("gunner").ClearContents
        Foldername.Copy Range("gunner")
    
        Open BatName For Output As #1
            For Each TestCell In Rng
                Print #1, TestCell.Text
                Print #1, TestCell.Offset(0, 1).Text
                Print #1,
            Next TestCell
        Close #1
        Call Shell(BatName, vbNormalFocus)
    Next Foldername
    
End Sub