Makro zum Erstellen einer Liste

[00202]

Hallo, :19:

jetzt auch mit Texten aus Tabelle4: :21:
[attachment=25990]

[snb]

@Case

Code:

Sub M_snb()
    Application.ScreenUpdating = False
    sn = Tabelle4.Cells(1).CurrentRegion
    
    For j = 1 To Val(Tabelle2.Cells(3, 4))
       If j = 1 Then Tabelle3.UsedRange.Clear
       Tabelle1.Range("A1:E6").Copy Tabelle3.Cells(1 + 7 * (j - 1), 1)
       Tabelle3.Cells(2 + 7 * (j - 1), 5) = sn(j, 1)
    Next
End Sub