Hi & welcome to the board.

How about
Sub keithK42()
   Dim Cl As Range
   
   For Each Cl In Range("A1", Range("A" & Rows.Count).End(xlUp))
      Cl.Copy Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(1 * Cl.Offset(, 1))
   Next Cl
End Sub