Sub Макрос1()
    With ActiveSheet
        Set rng_int = Application.Intersect(.UsedRange, .Columns("A:A"))
        fnd = .[e13].Value
        clr = .[e13].Interior.Color
    End With
    With rng_int
        Set c = .Find(fnd, LookIn:=xlValues)
        If Not c Is Nothing Then
            lv = c.Rows.OutlineLevel
            If lv = 4 Then
                m = 0
                For n = c.Row To 1 Step -1
                    If Rows(n).OutlineLevel = lv - m Then Range("A" & n).Resize(1, 2).Interior.Color = clr: m = m + 1
                    If m = 3 Then Exit For
                Next
            End If
        End If
    End With
End Sub