title: How to add a loop with a counter in vba
body: <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>