Sub Teilen()
i = 3
Do While Cells(i, 1) <> ""
If Cells(i, 1) = Cells(i - 1, 1) And Cells(i, 2) = Cells(i - 1, 2) Then
Cells(i, 1).EntireRow.Insert
Cells(i, 1) = Cells(i - 1, 1)
Cells(i, 2) = Cells(i - 1, 2)
Cells(i, 3) = Cells(i - 1, 3)
Cells(i, 4) = Cells(i - 1, 5) + 5
Cells(i, 5) = Cells(i + 1, 4) - 5
Cells(i, 6) = "100"
Cells(i, 7) = "0,01"
End If
i = i + 1
Loop
End Sub