If iCell <> "ОШИБКА" Then

If iCell <> "ОШИБКА" And iCell <> "" Then

Sub Макрос1()
'
    Dim iCell As Range, iURange As Range
    For Each iCell In Range("I1:J17")
        If iCell = "ДА" Then
            If iURange Is Nothing Then
                Set iURange = iCell
            Else
                Set iURange = Union(iURange, iCell)
            End If
        End If
        Next
    If Not iURange Is Nothing Then iURange.Offset(0, -1).Select
    
    
End Sub

Sub Макрос1()
'
    Dim iCell As Range, iURange As Range
    For Each iCell In Range("A1:A20")
        If iCell <> "ОШИБКА" Then
            If iURange Is Nothing Then
                Set iURange = iCell
            Else
                Set iURange = Union(iURange, iCell)
            End If
        End If
        Next
    If Not iURange Is Nothing Then iURange.Offset(0, 0).Select
    
    
End Sub

    Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy

=ЕСЛИ(ИЛИ(НЕ(ЕОШ(ПОИСК({"35""";"40""";"50""";"55"""};A1))));"ДА";"НЕТ")

Selection.Replace what:="Chr(9)", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

For Each cc In Selection.Cells
cc.Value = Replace(cc.Value, Chr(9), "")
Next

    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(Бюрократ [\S]*\/) \(([A-z]*)\)"
        For Each Rnb In Selection: Rnb.Value = .Replace(Rnb, "$1") & UCase(.Replace(Rnb, "$2"))
    Next
  End With

    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "([\S]*\/) \(([A-z]*)\)"
        For Each Rnb In Selection: Rnb.Value = .Replace(Rnb, "$1") & UCase(.Replace(Rnb, "$2"))
    Next
  End With

    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "Бюрократ ([\S]*\/) \(([A-z]*)\)"
        For Each Rnb In Selection: Rnb.Value = .Replace(Rnb.Value, "$1" & "$2")
    Next
  End With