Buenas tardes a los miembros de esté foro, en esta ocasión recurro a Uds, para que brinden su apoyo en un contador que vaya en el Workbook_Open, en donde se cuente 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 boton de Fusionar Consolidado con la macro que indico, se procese los registros como indica en la Contar.png y al culminar dicha fusión, se muestre el mensaje como la Culminado.png.

Sub FusionarRetribuciones(): On Error Resume Next
Dim Documento As String, Fila As Long
Hoja3.Range("A8").Resize(Hoja3.Range("B" & Rows.Count).End(xlUp).Row + 2, 43).Clear
Application.ScreenUpdating = False
Fila = 7
For x = 8 To Hoja1.Range("B" & Rows.Count).End(xlUp).Row
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.Speech.Speak "Consolidado terminado"
MsgBox ("Consolidado terminado"), , "AVISO"
Range("A4").Select

End Sub

Por lo que desde ya agradezco su colaboración y ayuda. Gracias.

@SALAVERRINO , siempre es mucho mejor subir un resumen de tu archivo que una imagen, en estas no se puede depurar código

Mirando por encima tu código, te dejo un ejemplo con los contadores insertados en los puntos que creo que deben ir, uno dependiendo de "Fila" y otro de "x", en función de los condicionales que tienes, pero si no son así, ya tienes la idea de cómo realizarlo:
 

Sub FusionarRetribuciones(): On Error Resume Next
Dim Documento As String, Fila As Long
Hoja3.Range("A8").Resize(Hoja3.Range("B" & Rows.Count).End(xlUp).Row + 2, 43).Clear
Application.ScreenUpdating = False

uF=Hoja1.Range("B" & Rows.Count).End(xlUp).Row

Fila = 7
For x = 8 To Hoja1.Range("B" & Rows.Count).End(xlUp).Row
If CStr(Hoja1.Range("B" & x)) <> Documento Then
Fila = Fila + 1
Hoja1.Rows(x).Copy Hoja3.Rows(Fila)
Documento = Hoja1.Range("B" & x)

Application.StatusBar="Consultando... " & Fila & "de " & uF & " - El proceso aun no termina"

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)"

Application.StatusBar="Consultando... " & x & "de " & uF & " - El proceso aun no termina"

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

End Sub

 

Buenos días amigo Haplox, el aporte brindado en la actualización de la macro, era lo que se pretendía obtener como resultado, por lo que daría como TEMA SOLUCIONADO.

Gracias.