Lav et antal kombinationer

Anbring koden i det aktuelle ark:

Sub kopiering()
Dim kopiRæk, værdi, antal
   
    kopiRæk = 1
   
    Application.ScreenUpdating = False
   
    For ræk = 1 To 65000
        værdi = Cells(ræk, 1)
        antal = Cells(ræk, 2)
       
Rem Når kol A er tom
        If værdi = "" Then
            Exit For
        End If
       
        If antal > 0 Then
            udførKopiering værdi, antal, kopiRæk
        End If
    Next ræk
   
    Application.ScreenUpdating = True
    MsgBox ("Kopiering udført")
End Sub
Private Sub udførKopiering(værdi, antal, kopiRæk)
    For k = 1 To antal
        Cells(kopiRæk, 3) = værdi
        kopiRæk = kopiRæk + 1
    Next k
End Sub

Super, det virker.... smider du et svar

Fint - det får du her...