title: Transposing In Particular Format
body: <p>Today I finished the loops section of by VBA course and have been doing a few practices, but I've come across a problem I cannot seem to figure out.</p>
  
  <p>I want to transpose data from sheet 1 to sheet to sheet 2. </p>
  
  <p>Sheet 1</p>
  
  <pre><code>a   1   2   3
  b   1   2   3   4   5   6
  c   1   2   3   4
  </code></pre>
  
  <p>I am trying to write a macro which will transpose the data into Sheet 2 like this:</p>
  
  <pre><code>a   1
  a   2
  a   3
  b   1
  b   2
  b   3
  b   4
  b   5
  b   6
  c   1
  c   2
  c   3
  c   4
  </code></pre>
  
  <p>I tried to write some VBA code, but I have no idea how to approach this particular problem. I tried using Do Until Loops, but the issue I run into is how I get the the letters in sheet 1, column 1 to paste with their corresponding numbers in sheet 2.</p>
  
  <p>A friend did some code for me to analyse, but it confused me even more. It works for this data set, but fails to do this with a larger data set (one where the letters go up to 'z').</p>
  
  <p>Here is his code:</p>
  
  <pre><code>Sub transpose()
      Sheets(1).Select
  
      lrow1 = Cells(Rows.Count, 1).End(xlUp).Row
  
      For i = 1 To lrow1
          nums = 2
  
          Cells(i, nums).Select
  
          Do Until IsEmpty(ActiveCell)
              nums = nums + 1
              Cells(i, nums).Select
          Loop
  
          Range(Cells(i, 2), Cells(i, nums)).Copy
          Sheets(2).Select
  
          lrow2 = Cells(Rows.Count, 2).End(xlUp).Row
  
          Cells(lrow2 + 1, 2).Select
  
          Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
              False, transpose:=True
  
          Sheets(1).Select
  
          Cells(i, 1).Copy
  
          Sheets(2).Select
  
          Cells(lrow2 + 1, 1).Select
  
          Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
              False, transpose:=False
  
          lrow3 = Cells(Rows.Count, 2).End(xlUp).Row
  
          Cells(lrow2 + 1, 1).Select
  
          Selection.AutoFill Destination:=Range(Cells(lrow2 + 1, 1), Cells(lrow3, 1)), Type:=xlFillDefault
  
          Sheets(1).Select
      Next i
  
      Sheets(2).Select
  
      Rows("1:1").Select
  
      Selection.Delete Shift:=xlUp
  End Sub
  </code></pre>
  
  <p><a href="https://pastebin.com/J45fmYKj" rel="nofollow noreferrer">https://pastebin.com/J45fmYKj</a></p>