Public Sub test()
Dim i As Integer, j As Double, k&

j = UserForm1.Width / 100
UserForm1.Show
UserForm1.Label1.Width = 1

For i = 1 To 100
UserForm1.Label1.Width = Int(i * j)
For k = 1 To 100000
Next k
DoEvents
Next
End Sub

Sub StatusBar3()
    Dim lr As Long
    Dim lAllCnt As Long 'кол-во итераций
    Const lMaxQuad As Long = 20 'сколько квадратов выводить
    lAllCnt = 10000

    For lr = 1 To lAllCnt
        Application.StatusBar = "Выполнено: " & Int(100 * lr / lAllCnt) & "%" & String(CLng(lMaxQuad * lr / lAllCnt), ChrW(9632)) & String(lMaxQuad - CLng(lMaxQuad * lr / lAllCnt), ChrW(9633))
        DoEvents
    Next
    'очищаем статус-бар от значений после выполнения
    Application.StatusBar = False
End Sub

  n = n + 1 / 4: p = 4 * n
  Application.StatusBar = "Выполнено: " & n * 100 & "% " & String(p, ChrW(8700)): DoEvents

Public Sub d()
    Application.ScreenUpdating = 0
    Application.StatusBar = "111111: " ':    DoEvents
    Application.ScreenUpdating = 1
    Application.StatusBar = False
End Sub

Sub SBOR()
Application.ScreenUpdating = False
Application.CutCopyMode = False
Application.DisplayAlerts = False

'задаем путь к данным
Dim myPath As String
myPath = GetFolderPath
'Задаем часть имени файла - номер месяца
Dim Month As String
Month = Application.InputBox("Введите номер месяца", Type:=2)
'Задаем имя отчета
Dim Gorod As Excel.Workbook
Set Gorod = ThisWorkbook

'Вставляем таблицу 1
Dim filenameTEMP As String
filenameTEMP = myPath + "\" + Month + "_TEMP.xlsx"

  n = n + 1 / 2: p = 2 * n
  Application.StatusBar = "Выполнено: " & n * 100 & "% " & String(p, ChrW(8700)): DoEvents

Workbooks.Open Filename:=filenameTEMP, UpdateLinks:=False
Workbooks(Month + "_TEMP.xlsx").Worksheets("1").Range("A2:C10").Copy
Gorod.Worksheets("ALL").Range("A2:C10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Workbooks(Month + "_TEMP.xlsx").Close

'Вставляем таблицу 2
Dim filenameTEMP As String
filenameTEMP = myPath + "\" + Month + "_TEMP.xlsx"

  n = n + 1 / 2: p = 2 * n
  Application.StatusBar = "Выполнено: " & n * 100 & "% " & String(p, ChrW(8700)): DoEvents

Workbooks.Open Filename:=filenameTEMP, UpdateLinks:=False
Workbooks(Month + "_TEMP.xlsx").Worksheets("2").Range("A2:C10").Copy
Gorod.Worksheets("ALL").Range("A12:C20").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Workbooks(Month + "_TEMP.xlsx").Close

Application.ScreenUpdating = True
Application.CutCopyMode = True
Application.DisplayAlerts = True
End Sub

Function GetFolderPath(Optional ByVal title As String = "Выберите папку", Optional ByVal initialPath As String = "P:\ФинДир\ОтделКонсолидации\Бюджет") As String
Dim PS As String: PS = Application.PathSeparator
    With Application.FileDialog(msoFileDialogFolderPicker)
        If Not Right(initialPath, 1) = PS Then initialPath = initialPath & PS
        .ButtonName = "Выбрать": .title = title: .InitialFileName = initialPath
        If .Show <> -1 Then Exit Function
        GetFolderPath = .SelectedItems(1)
        If Not Right(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath & PS
    End With
End Function

Dim filenameTEMP As String