Incremental count based on quantity

Maybe:

Sub test()

    Dim rngLoopRange As Range
    For Each rngLoopRange In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        With Range("D" & Rows.Count).End(xlUp).Offset(1, 0)
            .Value = rngLoopRange
            If rngLoopRange.Offset(0, 1) > 1 Then
                .AutoFill Destination:=.Resize(rngLoopRange.Offset(0, 1), 1)
            End If
            .Resize(rngLoopRange.Offset(0, 1), 1).Offset(0, 1) = 1
        End With
    Next rngLoopRange

End Sub

Dom

With formulas you can do it in a couple of steps.

Say your list is in A2:B4, then in C4 add a helper column to cumulatively sum the quantities:

=SUM(B$2:B2)

copied down

Then in a new column to get the right number of results:

=IF(ROWS(A$2:A2)>$C$4,"",LEFT(INDEX($A$2:$A$4,MIN(IF(ROWS(A$2:A2)<=$C$2:$C$4,ROW($A$2:$A$4)-ROW($A$2)+1))),LEN(INDEX($A$2:$A$4,MIN(IF(ROWS(A$2:A2)<=$C$2:$C$4,ROW($A$2:$A$4)-ROW($A$2)+1))))-3))

confirmed with CTRL+SHIFT+ENTER not just ENTER and copy down

Then in an adjacent column and assuming you put the above starting in E2:

=E2&TEXT(COUNTIF(E$2:E2,E2),"000")

entered with ENTER and copy down to get final results.