Looping a Code

Option Explicit
Sub Macro1()


    Const lngStartRow As Long = 2 'Starting row number for the existing data and output in Col. A. Change to suit if necessary.


    Dim lngLastRow As Long
    Dim lngPasteRow As Long
    Dim rngMyCell As Range
    Dim i As Integer
    
    Application.ScreenUpdating = False
    
    lngLastRow = Range("E:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For Each rngMyCell In Range("F" & lngStartRow & ":F" & lngLastRow)
        If Val(rngMyCell) > 0 Then
            For i = 1 To Val(rngMyCell)
                If lngPasteRow = 0 Then
                    lngPasteRow = lngStartRow
                Else
                    lngPasteRow = lngPasteRow + 1
                End If
                Range("A" & lngPasteRow).Value = rngMyCell.Offset(0, -1)
            Next i
        End If
    Next rngMyCell
    
    Application.ScreenUpdating = True
    
End Sub

Private Sub CommandButton1_Click()
    Dim y, x, i As Long, ii As Long, cnt As Long
    ReDim y(1 To Evaluate("=Sum(F1:F" & Range("F" & Rows.Count).End(xlUp).Row & ")"))
    x = Application.Transpose([E1].CurrentRegion): cnt = 1
    For i = 1 To UBound(x, 2)
        For ii = 1 To x(2, i)
            y(cnt) = x(1, i)
            cnt = cnt + 1
        Next ii
    Next i
    With [A1]
     .EntireColumn.ClearContents
     .Resize(UBound(y)).Value = Application.Transpose(y)
    End With
End Sub