Sub распознать()
    Dim r As Range
    Dim firstAddress As String
    Dim iLoop As Long
    Dim book1 As Workbook
    Dim Team As String
    
    Set book1 = Workbooks.Open("E:\Super M\Проект ставки\Поиск решения\Усов 4\БАЗА ДАННЫХ\болванка\сезон для проги\Англия\1-ое место\3.xlsx")
     Team = book1.Worksheets("3").Range("D34")
    With book1.Worksheets("3").Range("D33:D99")
        
        Set r = .Find(What:="Team")
        If Not r Is Nothing Then
            firstAddress = r.Address
            Do
                iLoop = iLoop + 1
                Set r = .FindNext(r)
            Loop While Not r Is Nothing And r.Address <> firstAddress And iLoop < 20
        End If
    End With
    book1.Worksheets("3").Range("D100").Value = iLoop
    book1.Save
    
End Sub