[a_axe]

сразу выделить диапазон организаций? »

Попробуйте код ниже:

Код:

Public Sub select_all_for_deleting()
    Dim rngStart As Range, rngEnd As Range, i As Integer, rngAll As Range
    Dim strStart As String, strEnd As String, strF As String, strErr As String, vrtTxt As Variant
    strF = InputBox("Введите через запятую (с пробелом) перечень", "Поиск", "ООО ЗСТ, ООО ВВВВ, ООО ООО, ООО МММ")
    vrtTxt = Split(strF, ", ")
    On Error Resume Next
    For i = LBound(vrtTxt) To UBound(vrtTxt)
        strStart = vrtTxt(i)
        strEnd = "Всего по: " & vrtTxt(i)
        Set rngStart = Cells.Find(What:=strStart, After:=ActiveSheet.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        Set rngEnd = ActiveSheet.Cells.Find(What:=strEnd, After:=rngStart, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Err.Number <> 0 Then
            strErr = strErr & strStart & ","
            Err.Clear
        Else
            If rngAll Is Nothing Then Set rngAll = Range(rngStart, rngEnd).EntireRow Else Set rngAll = Union(rngAll, Range(rngStart, rngEnd).EntireRow)
        End If
        
        Set rngStart = Nothing
        Set rngEnd = Nothing
    Next i
    
    If strErr <> "" Then MsgBox "Не найдены следующие запросы:" & strErr
    rngAll.Select
    Set rngAll = Nothing
End Sub