Option Explicit
Public Sub Test()
Dim rngData As Excel.Range
Dim rngRow As Excel.Range
Set rngData = Range("A1").CurrentRegion
Set rngData = rngData.Resize(rngData.Rows.Count - 1).Offset(1)
Set rngRow = rngData.Rows(1)
Do
Call rngRow.Resize(3).Offset(1).Insert(xlShiftDown)
Call rngRow.AutoFill(rngRow.Resize(4), xlFillCopy)
Set rngRow = rngRow.Offset(4)
Loop While rngRow.Row <= rngData.Rows(rngData.Rows.Count).Row
Set rngData = rngData.Resize(rngData.Rows.Count + 3)
With rngData.Columns(1).Offset(0, 2)
.Cells(1).Offset(-1).Value = "Teil"
.FormulaR1C1 = "=IF(RC[-2]=R[-1]C[-2],R[-1]C+1,1)"
.Cells(1).Value = 1
.Value = .Value
End With
End Sub