FName = Cells(1, 2).Value & ".*"

Sub get1()

'On Error GoTo Errors1 'обработок ошибок
Dim wb As Workbook, FName, FPath
FName = Cells(1, 2).Value & ".xlsx" 'имя файла
FPath = Cells(2, 2).Value 'путь к файлу
'
If Cells(1, 2).Value = "" Or Cells(1, 2).Value = "" Then Exit Sub
Application.ScreenUpdating = 0
'проверяем открыть ли файл: если нет, тогда открываем
If IsFileOpen(FPath & "\" & FName) = False Then
Set wb = GetObject(FPath & "\" & FName) 'открываем скрыто
Else: Set wb = Workbooks(FName)
End If
'если имя файла соовпадает с этим файлом, тогда выходим
If wb.Name = ThisWorkbook.Name Then Exit Sub

Set c = wb.Worksheets("Лист1").Range("A1:K20").Find("Заемщик", LookIn:=xlValues) 'Диапазон ячеек ГДЕ ищем
If Not c Is Nothing Then
Application.GoTo c, True
With ThisWorkbook.Worksheets("Отчет")
Range(Cells(ActiveCell.Row, ActiveCell.Column + 1), Cells(ActiveCell.Row + 3, ActiveCell.Column + 1)).Copy _
Destination:=.Cells(4, 2) 'копируем данные
End With
Else: ThisWorkbook.Worksheets("Отчет").Range("B4:B6").Value = ""
End If
ThisWorkbook.Activate
'закрываем файл без сохранении
'wb.Close 0
'если где та вылетить ошибка, тогда очищаем данные с ячеек "B4:B6"
GoTo Ends:
Errors1:
ThisWorkbook.Worksheets("Отчет").Range("B4:B6").Value = ""
Ends:
Application.ScreenUpdating = 1

End Sub

Else: Set wb = Workbooks(FName)

If .......  Like "Даулет.*" Then