Private Sub CommandButton1_Click()
ТекстДляПоиска = "ант"
[c1] = "C:\Users\Администратор\Desktop\ГУН"
' Ищем файлы в заданной папке по заданной маске,
' и выводим на лист список их параметров.
' Просматриваются папки с заданной глубиной вложения.

Dim coll As Collection, FolderPath$, searchmask$, searchdepth%
On Error Resume Next
FolderPath$ = [c1] ' берм из ячейки c1
searchmask$ = "*.*xl*" ' берм из ячейки c2
searchdepth% = 1 ' берм из ячейки c3
If searchdepth% = 0 Then searchdepth% = 999 ' без ограничения по глубине

' считываем в колекцию coll нужные имена файлов
Set coll = FilenamesCollection(FolderPath$, searchmask$, searchdepth%)

Application.ScreenUpdating = False ' отключаем обновление экрана

' выводим результаты (список файлов, и их характеристик) на лист
For i = 1 To coll.Count ' перебираем все элементы коллекции, содержащей пути к файлам

filenumber = i
pathtothefile = coll(i)
Filename = Dir(pathtothefile)
creationdate = FileDateTime(pathtothefile)
filesize = FileLen(pathtothefile)
filesize = FileOrFolderSize(filesize)
'------------------------------------------------------------------
ТекстДляПоиска = "*" & "ант" & "*"
Set СписокНомеровНайденныхСтрок = New Collection
On Error Resume Next ' отключаем останов при ошибке

Workbooks.Open Filename:=pathtothefile
Workbooks(pathtothefile).Activate
With ThisWorkbook.Worksheets("Лист1")
'------------------------------------------------------------------
ПоследняяСтрокаБД = .Range("a" & .Rows.Count).End(xlUp).Row ' вычисляем номер последней строки
Dim РезультатПоиска As Range, АдресПервойНайденнойЯчейки As String

Set РезультатПоиска = Cells.Find(ТекстДляПоиска, LookAt:=xlPart) ' начинаем поиск

If Not РезультатПоиска Is Nothing Then ' если нашли хоть одну подходящую ячейку
АдресПервойНайденнойЯчейки = РезультатПоиска.Address ' запоминаем Адрес Первой Найденной Ячейки
НомерСтроки = РезультатПоиска.Row ' получаем номер строки, в которой найдена подходящая ячейка
СписокНомеровНайденныхСтрок.Add НомерСтроки, CStr(НомерСтроки) ' записываем номер строки в список
Do
' ищем следующую ячейку
Set РезультатПоиска = Cells.FindNext(РезультатПоиска)

If Not РезультатПоиска Is Nothing Then ' если нашли очередную подходящую ячейку
НомерСтроки = РезультатПоиска.Row ' получаем номер строки, в которой найдена подходящая ячейка
СписокНомеровНайденныхСтрок.Add НомерСтроки, CStr(НомерСтроки) ' записываем номер строки в список
End If

' повторяем поиск до тех пор, пока не дойдм до Первой Найденной Ячейки
Loop While РезультатПоиска.Address <> АдресПервойНайденнойЯчейки
End If
'------------------------------------------------------------------
End With
ActiveWorkbook.Close False

On Error GoTo 0 ' отключение режима пропуска ошибок
'------------------------------------------------------------------
Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 5).Value = _
Array(filenumber, Filename, pathtothefile, creationdate, filesize)

' если нужна гиперссылка на файл во втором столбце
ActiveSheet.Hyperlinks.Add Range("b" & Rows.Count).End(xlUp), pathtothefile, "", _
"Открыть файл" & vbNewLine & Filename

Next

On Error GoTo 0

Range("a:e").EntireColumn.AutoFit ' автоподбор ширины столбцов
End Sub