Copy & insert the currently selected row of data multiple times

[georgiboy]

Just noticed that you wanted annotations:

Sub Test()
    Dim r As Long, str As String, rpt As Long, s As Variant  
    r = ActiveCell.Row ' assign "r" to be the active row
    str = Cells(r, 1) ' '"str" becomes the value in column A (column One) of the active row
    rpt = Cells(r, 2) ' '"rpt" becomes the value in column B (column Two) of the active row  
    ' inserts ("rpt" less one) rows under the active row ("r")
    ' So: (active row + 1) to (active row + (rpt - 1))
    ' This means that the count of active row and the newly inserted rows will be equal to "rpt" rows
    Rows(r + 1 & ":" & r + (rpt - 1)).Insert  
    With Application ' saves me typing Application over and over, anything that starts with "." now refers to Application
         ' creates an array with "rpt" amount of rows, the sequence starts at 1 and the step to the sequence is 0, therefore we get an array with "rpt" amount of 1's
         s = .Sequence(rpt, , 1, 0)
         ' resizes the range: column one active row to be "rpt" amount of rows starting at the active row
         ' the .Rept part repeats the "str" once for every time there is a one in the sequence of 1's we created in the array "s"
         ' so the resized range now = the array of "str" we created
         Cells(r, 1).Resize(rpt) = .Rept(str, s)
         ' resizes the range: column two active row to be "rpt" amount of rows starting at the active row
         ' as "s" is now just an array of 1's with a count of "rpt" we can just make the resized range = "s"
         Cells(r, 2).Resize(rpt) = s
     End With
End Sub