Option Explicit

Sub Импорт()
MsgBox "Внимание!!!Необходимо выбрать уже заполненный файл. следуйте инструкции!"

Dim BazaWb As Workbook 'файл для сбора данных
Dim BazaSht As Worksheet 'лист в файле для сбора данных
Dim SelectedItem As String 'имя файла выбранного в диалоге
Dim oAwb As String 'имя открытой книги

With Application
'отлючаем обновление экрана - это убыстрит работу макроса
.ScreenUpdating = False
'включаем ручной пересчёт формул - это убыстрит работу макроса
.Calculation = xlManual
'отключаем отображения окон на панели задач на время выполнения макроса
.ShowWindowsInTaskbar = False
'присваиваем переменной BazaWb ссылку на общий файл
Set BazaWb = ActiveWorkbook
'включаем автоматический пересчёт формул, который отключили в начале макроса
.Calculation = xlAutomatic
'включаем отображения окон на панели задач, которое отключали в начали макроса
.ShowWindowsInTaskbar = True
'включаем обновление экрана, который отключили в начале макроса
.ScreenUpdating = True

'вызываем диалог выбора папки с файлами отчёта
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите файл для отчета" 'надпись в окне диалога
'путь по умолчанию к папке /где расположен исходный файл
.InitialFileName = ThisWorkbook.Path & Application.PathSeparator & "*.xlsx*"
.AllowMultiSelect = False 'запрет выбора нескольких файлов
If .Show = False Then GoTo ErrExt:
'For Each SelectedItem In .SelectedItems 'перебор файлов в папке
SelectedItem = .SelectedItems(1) 'при обработке нескольких - удалить
oAwb = Dir(SelectedItem, vbDirectory) 'запоминаем имя книги
Workbooks.OpenText SelectedItem 'открываем книгу
'операции с открытой книгой
With ActiveWorkbook
'перебор заданных листов для копирование
.Sheets("Свод").Copy Before:=BazaWb.Sheets(1)
.Sheets("ЮЛ и ИП").Copy Before:=BazaWb.Sheets(2)
.Sheets("ФЛ кроме ипотеки и однородных").Copy Before:=BazaWb.Sheets(3)
.Sheets("Ипотека").Copy Before:=BazaWb.Sheets(4)
.Sheets("Однородные").Copy Before:=BazaWb.Sheets(5)
.Sheets("Ипотека ПОЗ").Copy Before:=BazaWb.Sheets(6)
.Sheets("Гарантии").Copy Before:=BazaWb.Sheets(7)
.Sheets("Прил2").Copy Before:=BazaWb.Sheets(8)
.Sheets("Прил4").Copy Before:=BazaWb.Sheets(9)
.Sheets("таблица категорий").Copy Before:=BazaWb.Sheets(10)
End With
Workbooks(oAwb).Close False 'закрываем книгу
'Next SelectedItem
End With
ErrExt:
End With
MsgBox "Необходимые листы скопированы, для проверки отчёта необходимо перейти на Рабочий лист"
End Sub