Option Explicit
Sub Test()
Dim lngZeile As Long
Dim lngZeileMax As Long
Dim lngGrpCI As Long
Dim blnFoundGrp As Boolean
Dim blnFound As Boolean
lngGrpCI = 43
lngZeileMax = Cells(Rows.Count, "A").End(xlUp).Row
For lngZeile = 1 To lngZeileMax
If Not blnFoundGrp Then
If Cells(lngZeile, "A").Interior.ColorIndex = lngGrpCI Then
blnFoundGrp = True
End If
End If
If blnFoundGrp Then
If Cells(lngZeile, "A").Interior.ColorIndex <> lngGrpCI Then
Call Rows(lngZeile).Insert(xlShiftDown)
Cells(lngZeile, "A").Value = Cells(lngZeile - 1, "A").Value
Exit For
ElseIf Cells(lngZeile, "B").Text = "" Then
Exit For
ElseIf lngZeile = lngZeileMax Then
lngZeileMax = lngZeileMax + 1
lngZeile = lngZeileMax
Call Rows(lngZeile).Insert(xlShiftDown)
Cells(lngZeile, "A").Value = Cells(lngZeile - 1, "A").Value
Exit For
End If
End If
Next
If lngZeile > lngZeileMax Then
Call MsgBox("nichts gefunden", vbExclamation)
Exit Sub
End If
Cells(lngZeile, "B").Value = "TestB"
Cells(lngZeile, "C").Value = "TestC"
Cells(lngZeile, "D").Value = "TestD"
Cells(lngZeile, "E").Value = "TestE"
End Sub