File names list

Sub FindWordDisplayFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim sWhat As String
Dim r As Range
Dim x As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

sWhat = InputBox("Find what?")

On Error Resume Next
    Set wbCodeBook = ThisWorkbook
        With Application.FileSearch
            .NewSearch
            'Change path to suit
            .LookIn = "C:\MyDocuments\TestResults"
            .FileType = msoFileTypeExcelWorkbooks
                If .Execute > 0 Then
                    For lCount = 1 To .FoundFiles.Count
                        Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
    
    Set r = Cells.Find(What:=sWhat, LookAt:=xlPart)
    If Not r Is Nothing Then
            'Change destiantion file to suit and make sure it's not in same folder as path above
            Workbooks("Destination.xls").Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveWorkbook.FullName
    End If

                        wbResults.Close SaveChanges:=False
                    Next lCount
                End If
        End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub