How to add a loop with a counter in vba
<p>I have a column of IDs in an Excel worksheet called Sheet1. I have data that corresponds to the IDs in columns to the right of Column A. The amount of cells in a row varies. For example:</p>

<p>A, B, C, D, E, F, ...</p>

<p>John, 5, 10, 15, 20</p>

<p>Jacob, 2, 3</p>

<p>Jingleheimmer, 5, 10, 11</p>

<p>I'm trying to copy that data into a new worksheet, Sheet5, in the following format:</p>

<p>A, B, C, D, E, F, ...</p>

<p>John, 5</p>

<p>John, 10</p>

<p>John, 15</p>

<p>John, 20</p>

<p>Jacob, 2</p>

<p>Jacob, 3</p>

<p>Jingleheimmer, 5</p>

<p>Jingleheimmer, 10</p>

<p>Jingleheimmer, 11</p>

<p>I wrote the following code that copies over the first two IDs. I could continue to copy paste the second half of the code and just change the cells, however, I have 100s of IDs. This would take too long. I think whenever a process is repeated I should be using a loop. Can you help me turn this repetitive code into a loop?</p>

<pre><code>Sub Macro5()

Dim LastRowA As Integer
Dim LastRowB As Integer

''' Process of copying over first ID '''

'grab all data cells in B2 to the right
With Sheets("Sheet1").Select
Range("B2", Range("B2").End(xlToRight)).Select
Selection.Copy
End With

'paste that data into the first empty cell of Column B in Sheet5
With Sheets("Sheet5").Select
Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End With

'grab the corresponding ID in cell A2
With Sheets("Sheet1").Select
Range("A2").Select
Application.CutCopyMode = False
Selection.Copy
End With

'paste the corresponding ID into the first empty cell of Column A in Sheet5
With Sheets("Sheet5").Select
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A1:A" &amp; LastRowB)
End With

''' Repeat that process for each row in Sheet1 '''

'grab all data cells in B3 to the right
With Sheets("Sheet1").Select
Range("B3", Range("B3").End(xlToRight)).Select
Selection.Copy
End With

'paste that data into the first empty cell of Column B in Sheet5
With Sheets("Sheet5").Select
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" &amp; LastRowB + 1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End With

'grab the corresponding ID in cell A3
With Sheets("Sheet1").Select
Range("A3").Select
Application.CutCopyMode = False
Selection.Copy
End With

'paste the corresponding ID into the first empty cell of column A in Sheet5
'and autofill down to the last populated cell in column B
With Sheets("Sheet5").Select
LastRowA = Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" &amp; LastRowB + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
Selection.AutoFill Destination:=Range("A" &amp; LastRowA &amp; ":A" &amp; LastRowB)
End With

End Sub
</code></pre>