Poner total a ultima fila con tabla que cambia

hola doña elsa como estas? Estoy haciendo unos ajustes a una tabla para un reporte tomando en cuenta que uso excel 2010, tengo dos hojas de reporte salarial y administrativo cuyos movimientos son filtrados desde una hoja llamada jornada, ahi todo va muy bien

mi objetivo es ponerle los totales al final de los movimientos filtrados y una raya con el nombre debajo para que el empleado firme

como ejemplo digamos que el filtro mostró 6 filas, en la fila 7 debería mostrar los totales de las horas salario bruto deducción y neto y un poco mas abajo digamos unas 3 filas abajo del total una raya con el nombre del empleado para que el firme

no se si se podría hacer

intente poniéndolo de esta manera

Private Sub Worksheet_Change(ByVal Target As Range)
Z = Hoja2.Range("I500000").End(xlUp).Row
If Not Intersect(Target, Range("C2:E2")) Is Nothing Then
 Hoja2.Range("A5:I" & Z).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
 Range("C1:E2"), CopyToRange:=Range("A10:I10"), Unique:=False
End If
'hasta aqui funciona bien, de aqui para abajo no funciona
Range("A6").Select
Do While Not IsEmpty(ActiveCell)
 ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 4).FormulaR1C1 = "=SUM(R[-48]C:R[-1]C)"
ActiveCell.Offset(0, 5).FormulaR1C1 = "=SUM(R[-48]C:R[-1]C)"
ActiveCell.Offset(0, 6).FormulaR1C1 = "=SUM(R[-48]C:R[-1]C)"
ActiveCell.Offset(0, 7).FormulaR1C1 = "=SUM(R[-48]C:R[-1]C)"
ActiveCell.Offset(0, 8).FormulaR1C1 = "=SUM(R[-48]C:R[-1]C)"
End Sub

pero sin resultado alguno