Boa tarde amigos!

Estou tendo dificuldades com uma planilha. Gostaria de conseguir somar vários números de acordo com a quebra de página. Não entendo muito bem de VBA, mas consegui um código na internet que quase me atendeu.

Por exemplo, tenho uma planilha com vários números na coluna "D" que vão de D6 até D116. Eu gostaria de uma macro que realize a soma (subtotal) de cada página de acordo com a quebra de página. Nesse exemplo eu possuo uma quebra de página em "D50", então gostaria que fosse realizado a soma de "D6:D50". A próxima quebra de página é na "D100", então eu gostaria que fosse realizado uma soma de "D51:D100". E no final de todas quebras de página me desse um total geral com todas as somas acima.

Eu tenho um código que quase me atendeu, porém quando chega no último número da página, a soma está sobrepondo o mesmo e com isso não está somando ele. Se alguém puder me ajudar eu agradeço muito mesmo. Estou enviado uma "PLANILHA TESTE" para tentar entender o problema que ocorre.

Segue abaixo também o código separado:

Sub Inserir_subtotais_em_quebra_paginas()
Dim i As Byte
Dim vUltima_Linha As Integer, vLinha As Integer, vPagina As Integer
Dim vTotal As Double

vLinha = 6
vUltima_Linha = Range("D1048576").End(xlUp).Row

ActiveSheet.HPageBreaks.Add Before:=Cells(vUltima_Linha + 1, 4)
vTotal = Application.WorksheetFunction.Sum(Range("D6:D" & vUltima_Linha))

Application.ScreenUpdating = False
For i = 1 To ActiveSheet.HPageBreaks.Count
vPagina = ActiveSheet.HPageBreaks(i).Location.Row - 1
Rows(vPagina).Insert

With Cells(vPagina, 4)
   .Value = Application.WorksheetFunction.Sum(Range("D" & vLinha & ":D" & vPagina - 1))
   .Interior.ColorIndex = 3
End With

vLinha = vPagina + 1
Next i

With Cells(vPagina + 1, 4)
   .Value = vTotal
   .Interior.ColorIndex = 5
End With

Application.ScreenUpdating = True
End Sub