Sub-rotina VBA diminui muito após a primeira execução

Eu tenho uma sub-rotina que gera um relatório de desempenho de diferentes carteiras em 5 famílias. O fato é que os portfólios em questão nunca são os mesmos e o valor em cada família também. Portanto, copio e colo um modelo (que é formatado e ...) e adiciono a linha formatada (contendo a fórmula e ...) na família certa para cada portfólio no relatório. Tudo funciona muito bem, o código não é ideal e perfeito, é claro, mas funciona bem para o que precisamos. O problema não é o código em si, é que, quando executo o código pela primeira vez, ele passa muito rápido (como 1 segundo) ... mas, a partir da segunda vez, o código diminui drasticamente (quase 30 segundos para uma versão básica). tarefa idêntica à primeira). Eu tentei todo o cálculo manual, não atualizando a tela e ... mas não é realmente de onde o problema vem. Parece um vazamento de memória para mim, mas não consigo encontrar onde está o problema! Por que o código é executado muito rápido, mas é muitíssimo mais lento logo após ... Qualquer que seja o tamanho do relatório e o conteúdo do arquivo, eu precisaria fechar o Excel e reabri-lo para cada relatório.

** Não tenho certeza se estou claro, mas não é porque o código aumenta o arquivo do Excel ou algo assim, porque, após a primeira (rápida) execução, se eu salvar a pasta de trabalho, feche e reabra, a (nova) primeira execução novamente será muito rápido, mas se eu tivesse feito a mesma coisa sem fechar e reabrir, teria sido muito lento ... ^! ^!

Dim Family As String
Dim FamilyN As String
Dim FamilyP As String
Dim NumberOfFamily As Integer
Dim i As Integer
Dim zone As Integer


Sheets("RapportTemplate").Cells.Copy Destination:=Sheets("Rapport").Cells
Sheets("Rapport").Activate

i = 3
NumberOfFamily = 0
FamilyP = Sheets("RawDataMV").Cells(i, 4)
While (Sheets("RawDataMV").Cells(i, 3) <> "") And (i < 100)

    Family = Sheets("RawDataMV").Cells(i, 4)
    FamilyN = Sheets("RawDataMV").Cells(i + 1, 4)

    If (Sheets("RawDataMV").Cells(i, 3) <> "TOTAL") And _
    (Sheets("RawDataMV").Cells(i, 2) <> "Total") Then

        If (Family <> FamilyP) Then
            NumberOfFamily = NumberOfFamily + 1
        End If
        With Sheets("Rapport")
            .Rows(i + 8 + (NumberOfFamily * 3)).EntireRow.Insert
            .Rows(1).Copy Destination:=Sheets("Rapport").Rows(i + 8 + (NumberOfFamily * 3))
            .Cells(i + 8 + (NumberOfFamily * 3), 6).Value = Sheets("RawDataMV").Cells(i, 2).Value
            .Cells(i + 8 + (NumberOfFamily * 3), 7).Value = Sheets("RawDataMV").Cells(i, 3).Value
        End With
    End If
    i = i + 1
    FamilyP = Family
Wend

For i = 2 To 10
    If Sheets("Controle").Cells(16, i).Value = "" Then
        Sheets("Rapport").Cells(1, i + 11).EntireColumn.Hidden = True
    Else
        Sheets("Rapport").Cells(1, i + 11).EntireColumn.Hidden = False
    End If
Next i
Sheets("Rapport").Cells(1, 1).EntireRow.Hidden = True

'Define printing area
zone = Sheets("Rapport").Cells(4, 3).End(xlDown).Row
Sheets("Rapport").PageSetup.PrintArea = "$D$4:$Y$" & zone


Sheets("Rapport").Calculate
Sheets("RANK").Calculate
Sheets("SommaireGroupeMV").Calculate
Sheets("SommaireGroupeAlpha").Calculate
Application.CutCopyMode = False

End Sub