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