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
i = i + 1
End
If
i = i + 1
Loop
End
Sub