For preestablish = musquashroot + 1 To UBound(portmanteaux)
If portmanteaux(preestablish).oversecurely = phentolamine Then
rumpelstiltskin = rumpelstiltskin + portmanteaux(preestablish).sheepsteal
redemptive = redemptive + portmanteaux(preestablish).liableness
nonprevalence = nonprevalence + portmanteaux(preestablish).waldgravine
portmanteaux(preestablish).picturesquely = 1

Public Sub анализ2()

On Error Resume Next

Dim t As Single ' таймер для замера времени работы макроса
t = Timer

'Application.ScreenUpdating = False             ' эти "ускорения" не влияют на результат
'Application.Calculation = xlCalculationManual

progress 0, " очистить V_list"   ' прогресс работы в Application.StatusBar

V_list5.Cells.Clear      ' V_list5 - это имя листа в модуле VBA

Dim i As Integer
Dim s As String
Dim s1 As String

s1 = Analiz2.Cells(2, 3).Value & ".xlsb"     ' Получили имя файла базы данных
s = Application.ThisWorkbook.Path & "\" & s1  ' добавили к нему путь (в одной папке с этой книгой)

If Not IsEmpty(Analiz2.ListObjects("Таблица3").DataBodyRange) Then Analiz2.ListObjects("Таблица3").DataBodyRange.Delete

If Dir(s) = "" Then   ' если файл не существует, то сообщение об ошибке
  MsgBox "Файл " & Chr(10) & Analiz2.Cells(2, 3).Value & ".xlsb" & Chr(10) & "не существует.", 0, "Ошибка"
Else

progress 1, " Открываю файл " & Chr(171) & Analiz2.Cells(2, 3).Value & ".xlsb" & Chr(187)
Dim myBook As Workbook
Dim filo As Boolean   ' флаг, показывает что база данных сейчас не открыта, надо открывать файл

Set myBook = Workbooks(s1)
filo = myBook Is Nothing
If filo Then
Workbooks.Open s, 0, True
End If

progress 3, " Копирую из файла " & Chr(171) & Analiz2.Cells(2, 3).Value & ".xlsb" & Chr(187)

Dim ws As Worksheet
Dim crows As Integer
Set ws = Workbooks(s1).Sheets("RH_BaseAll")    ' получаю доступ к листу базы данных
crows = ws.ListObjects("Таблица1").ListRows.Count- 1   ' получаю число строк умной таблицы базы данных
V_list5.Range("B1").Value = crows         ' вывожу себе в ячейку для проверки

' Далее идет выкопировка данных
ws.ListObjects("Таблица1").Range.Columns(IsxNumLine).Copy            ' здесь используются константы с номерами нужных столбцов
V_list5.Cells(4, TarNumLine).PasteSpecial (xlPasteValuesAndNumberFormats)  ' Isx-исходники из базы данных, Tar-номер столбца на моем листе V_list5
ws.ListObjects("Таблица1").Range.Columns(IsxNumIzometr).Copy
V_list5.Cells(4, TarNumIzometr).PasteSpecial (xlPasteValuesAndNumberFormats)
ws.ListObjects("Таблица1").Range.Columns(IsxNumYarus).Copy
V_list5.Cells(4, TarNumYarus).PasteSpecial (xlPasteValuesAndNumberFormats)
'  ....... Копирую 27 столбцов .......

Application.CutCopyMode = False  ' выйти из режима копирования

progress 4, " Закрываю файл " & Chr(171) & Analiz2.Cells(2, 3).Value & ".xlsb" & Chr(187)

If filo Then    ' если файл базы данных был открыт моим макросом, тогда закрываю его
  Workbooks(s1).Close False    ' без сохранения
End If

Sub progress(x As Integer, s As String)
Application.StatusBar = " --- " & x & "% --- " & s
DoEvents
End Sub

‘…….. в макросе: 
For i = 5 To (crows + 5)
If ((i Mod 1000) = 0) Then progress ((i - 5) * (90) / 25500), "Обрабатываю строку № " & i

‘…… далее идет сложная обработка