Hi Thimo,
probiers mal mit diesem Code:
Sub Iterieren()
i = 2 'Beginn in Zeile
Do 'Zeilen einfügen
If Cells(i, 1) <> "" And Cells(i, 2) <> "" Then
w = Cells(i, 2)
Cells(i, 2) = 1
Cells(i, 3) = Cells(i, 1) & "_" & 1
If w > 1 Then
Cells(i, 1).Offset(1, 0).Resize(w - 1, 1).EntireRow.Insert xlDown
Cells(i, 2).AutoFill Cells(i, 2).Resize(w, 1), xlFillSeries
Cells(i, 3).AutoFill Cells(i, 3).Resize(w, 1), xlFillSeries
End If
i = i + w
End If
Loop Until Cells(i, 1) = "" And Cells(i, 2) = ""
'Rahmen setzen
For k = 7 To 12
Range(Cells(1, 1), Cells(i - 1, 3)).Borders(k).LineStyle = xlContinuous
Next k
'Überschrift setzen
Range("C1") = "Identifier"
End Sub
Gruß Mr. K.
|