Barra de Progreso mostrando Porcentaje de Avance

A los miembros de esté foro, en esta ocasión recurro a Uds, para que brinden su apoyo en mostrar el Porcentaje de Avance de acuerdo al contador que vaya en el Workbook_Open, en donde halla contado la cantidad de registros que sería a partir de la B8 hasta el final (en este caso tiene 181 registro o podría ser) y que al presionar el botón de Fusionar Consolidado con la macro que indico, se procese los registros como indica en la Imagen 1, pero bajo esa misma primicia se agregue el % de acuerdo a la cantidad de registros valla procesando y al culminar dicha fusión, se muestre el mensaje como la Imagen 2.

Sub FusionarRetribuciones(): On Error Resume Next

    Dim Documento As String, Fila As Long

    Dim u

    '

    Application.ScreenUpdating = False

    Application.StatusBar = False

    '

    reg = Hoja1.Range("B" & Rows.Count).End(xlUp).Row - 7

    Hoja3.Range("A8").Resize(Hoja3.Range("B" & Rows.Count).End(xlUp).Row + 2, 43).Clear

    Fila = 7

    For x = 8 To Hoja1.Range("B" & Rows.Count).End(xlUp).Row

        Application.StatusBar = "Consultando ... " & x - 7 & " de " & reg & " - El proceso aún no termina."

        If CStr(Hoja1.Range("B" & x)) <> Documento Then

            Fila = Fila + 1

            Hoja1.Rows(x).Copy Hoja3.Rows(Fila)

            Documento = Hoja1.Range("B" & x)

        Else

            If Hoja1.Range("D" & x) < Hoja3.Range("D" & Fila) Then

                Hoja3.Range("D" & Fila) = Hoja1.Range("D" & x)

            End If

            If Hoja1.Range("E" & x) > Hoja3.Range("E" & Fila) Then

                Hoja3.Range("E" & Fila) = Hoja1.Range("E" & x)

            End If

            For y = 6 To 43

                Hoja3.Cells(Fila, y) = Hoja3.Cells(Fila, y) + Hoja1.Cells(x, y)

                If Hoja3.Cells(Fila, y) = 0 Then Hoja3.Cells(Fila, y) = ""

            Next

        End If

    Next

    Hoja1.Rows(x).Copy Hoja3.Rows(Fila + 1)

    For y = 11 To 42

        Hoja3.Cells(Fila + 1, y).FormulaR1C1 = "=SUM(R[-" & Fila - 7 & "]C:R[-1]C)"

    Next

    Hoja3.Cells(Fila + 1, 35) = ""

    '

    Application.StatusBar = "Se realizaron todas las consultas."

    Application.Speech.Speak "Consolidado terminado"

    MsgBox ("Consolidado terminado"), , "AVISO"

    Range("A4").Select

    Application.StatusBar = False

End Sub

Imagen 1

Imagen 2

Como siempre agradeciendo a los miembros de este foro, ante su apoyo brindado.