В чем проблема этого кода?

Question

[Just_Andrew]

Этот код поиска в exel.
Он находит первую подходящую ячейку на листе, выводит ее и переходит на следующий лист.
Но мне нужно чтобы он находил все возможные ячейки в книге.
Пример:
То что сейчас.
Искомая фраза Lexus
Выдает первое вхождение Lexus 350
То что хотелось бы получить.
Искомая фраза Lexus
Выдает Lexus 350, Lexus LX, Lexus GX...

Причем если подходящие ячейки находятся на разных листах, то все работает как надо.

Option Explicit

Sub Поиск()
Dim iFoundRng As Range
Dim iSheet As Worksheet
Dim iFoundSht As Worksheet
Dim firstAddress As String
Dim TextToFind As Variant
Dim iLastRow As Long
Dim iShtName As String
    
    Set iFoundSht = Sheets("Оглавление") 'лист "Поиск" присваиваем переменной
    iFoundSht.Range("A11:F5000").Clear 'очищаем диапазон ячеек на листе Поиск
    'TextToFind = Application.InputBox("Введите строку для поиска" & Chr(13) & Chr(13) & "Например: Lexus или Lexus 350", "Поиск", "Lexus 350")
    TextToFind = iFoundSht.Range("E7")
    If TextToFind = "" Or TextToFind = False Then Exit Sub 'если ничего не ввели - Выход!
    TextToFind = Trim(TextToFind) 'убираем начальные и конечные пробелы
    Application.ScreenUpdating = False 'отключаем обновление экрана
    For Each iSheet In ThisWorkbook.Worksheets 'поиск по листам
        If iSheet.Name <> iFoundSht.Name Then
            If iSheet.FilterMode = True Then iSheet.ShowAllData 'если на листе установлен автофильтр, то снимаем его
            Set iFoundRng = iSheet.Cells.Find(TextToFind, , xlFormulas, xlPart)
            If Not iFoundRng Is Nothing Then 'если нашли
                firstAddress = iFoundRng.Address 'запоминаем адрес найденной ячейки, чтобы продолжить поиск по листу
                Do
                    With iFoundSht
                        iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'определяем последнюю заполненную строку на листе поиск
                        If iLastRow = 1 Then iLastRow = 4 'если лист пуст, то вставлять будем начиная с 7-й строки
                        If iShtName <> iSheet.Name Then 'если новый прайс-лист
                            With .Cells(iLastRow + 1, 1) 'проставляем имя листа
                                .Value = iFoundRng.Offset(0, 0)
                                'добавляем гиперссылку
                                iFoundSht.Hyperlinks.Add Anchor:=iFoundSht.Cells(iLastRow + 1, 1), Address:="", _
                                    SubAddress:="'" & iSheet.Name & "'" & "!" & iFoundRng.Address, ScreenTip:="Перейти на лист " & iSheet.Name
                                .Font.Bold = True 'выделяем жирным
                                .Font.Size = 16
                                .HorizontalAlignment = xlRight
                            End With
                        End If
                        'iFoundRng.EntireRow.Copy Destination:=.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1) 'копируем всю строку
                        iShtName = iSheet.Name 'запоминаем имя листа
                    End With
                    Set iFoundRng = iSheet.Cells.FindNext(iFoundRng) 'продолжаем поиск на том же листе
                Loop While iFoundRng.Address <> firstAddress
            End If
        End If
    Next iSheet
    Application.ScreenUpdating = True 'включаем обновление экрана
    'MsgBox "Поиск завершён!", 64, "Поиск"
End Sub