Hi Sandra,

hatte Lust den Weg über Filter zu versuchen.

Versuch doch mal, ob die gewünschten Zeilen ordentlich gelb markiert werden. Wenn das Ergebnis passt, kann man das Färben durch Löschen ersetzen:

Option Explicit

Sub FindeUndFärbe()
    Dim sArr(2) As String
    Dim xAreas As Long, byt As Byte, lCalc As Long, lEvents As Long
    Dim rng As Excel.Range
    'Fehlerbehandlung
    On Error GoTo FinishErr
    'TurnOff Functionality
    With Application
        lCalc = .Calculation
        lEvents = .EnableEvents
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    'Filterkriterien
    sArr(0) = "292*"
    sArr(1) = "293*"
    sArr(2) = "294*"
    'Filterbereich; ggf. durch geeigneteres ändern
    Set rng = ActiveSheet.Range("A1").CurrentRegion
    'Schleife für Filterkriterien
    For byt = LBound(sArr) To UBound(sArr)
        'Filtern
        rng.AutoFilter Field:=1, Criteria1:=Array("=", sArr(byt)), Operator:=xlFilterValues
        'Anzahl Filterbereiche ermitteln
        xAreas = rng.SpecialCells(xlCellTypeVisible).Areas.Count
        'Filterbereiche auf Bedingungen prüfen und Zielzellen markieren
        While xAreas > 1
            With rng.SpecialCells(xlCellTypeVisible).Areas(xAreas)
                If .Cells(1, 1).Value Like sArr(byt) Then
                    If .Rows.Count > 1 Then .Resize(.Rows.Count - 1).Offset(1).Interior.Color = RGB(255, 255, 0)
                End If
            End With
            xAreas = xAreas - 1
        Wend
    Next byt
    '
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    '
FinishErr:
Select Case Err.Number
    Case Is <> 0
        MsgBox Err.Number & vbNewLine & Err.Description
End Select
'TurnOnFunctionality
    With Application
        .Calculation = lCalc
        .EnableEvents = lEvents
        .ScreenUpdating = True
    End With
'
Set rng = Nothing
Erase sArr()
'
End Sub