Код по поиску заданного значения во всех таблицах выбранной директории

Loop While strFirstAddress <> rFound.Address

Public Sub SearchFolders()
 
Dim fso As Object
Dim fld As Object
Dim strSearch As String
Dim strPath As String
Dim strFile As String
Dim wOut As Worksheet
Dim wbk As Workbook
Dim wks As Worksheet
Dim lRow As Long
Dim rFound As Range
Dim strFirstAddress As String
 
On Error GoTo ErrHandler
 
Application.ScreenUpdating = False
 
'Change as desired
Dim FD As FileDialog
        Set FD = Application.FileDialog(msoFileDialogFolderPicker)
        With FD
            .AllowMultiSelect = False
            .Title = "Укажите нужную директорию"
            .ButtonName = "Выбрать папку"
            If .Show = False Then Exit Sub Else strPath = .SelectedItems(1) & Application.PathSeparator
        End With
        Set FD = Nothing
        
 
strSearch = InputBox("Введите искомое слово:", "Поиск", "")
 
If strSearch = "" Then
Exit Sub
End If
 
Set wOut = Worksheets("Данные")
 
lRow = 9
lRowCount = 1
 
With wOut
.Range("A10:K500").ClearContents
 
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(strPath)
strFile = Dir(strPath & "\*.xls*")
 
Do While strFile <> ""
    Set wbk = Workbooks.Open _
        (Filename:=strPath & "\" & strFile, _
        UpdateLinks:=0, _
        ReadOnly:=True, _
        AddToMRU:=False)
        For Each wks In wbk.Worksheets
        
            Set rFound = wks.UsedRange.Find(strSearch)
            LastRow = Cells(10, 1).End(xlDown).Row
                If Not rFound Is Nothing Then
                  strFirstAddress = rFound.Address
                End If
            Do
              If rFound Is Nothing Then
                Exit Do
              Else
                rFoundRow = rFound.Row
                RowCounter = RowCounter + 1
                lRow = lRow + 1
                .Rows(lRow) = Rows(rFoundRow).Value
                .Cells(lRow, 1) = lRowCount
 
              End If
             lRowCount = lRowCount + 1
            Set rFound = wks.Cells.FindNext(After:=rFound)
            Loop While strFirstAddress <> rFound.Address
        Next
    
    wbk.Close (False)
    strFile = Dir
Loop
 
End With
 
MsgBox "Готово"
Worksheets("Данные").Activate
ExitHandler:
 
Set wOut = Nothing
Set wks = Nothing
Set wbk = Nothing
Set fld = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
Exit Sub
 
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
 
End Sub