La subrutina VBA se ralentiza mucho después de la primera ejecución

Tengo una subrutina que genera un informe de rendimiento de diferentes carteras dentro de 5 familias. El caso es que las carteras en cuestión nunca son las mismas y la cantidad en cada familia tampoco. Entonces, copio y pego una plantilla (que está formateada y ...) y agrego la fila formateada (que contiene la fórmula y ...) en la familia correcta para cada cartera en el informe. Todo funciona bien, el código no es óptimo y perfecto, por supuesto, pero funciona bien para lo que necesitamos. El problema no es el código en sí, es que cuando ejecuto el código la primera vez, va muy rápido (como 1 segundo) ... pero a partir de la segunda vez, el código se ralentiza drásticamente (casi 30 segundos por un tiempo básico tarea idéntica a la primera). Intenté todo el cálculo manual, no actualicé la pantalla y ... pero realmente no es de donde viene el problema. ¡Me parece una pérdida de memoria, pero no puedo encontrar dónde está el problema! ¿Por qué el código se ejecuta muy rápido pero muuuucho más lento justo después ... Cualquiera sea la longitud del informe y el contenido del archivo, necesitaría cerrar Excel y volver a abrirlo para cada informe.

** No estoy seguro si estoy claro, pero no es porque el código hace que el archivo de Excel sea más grande o algo así, porque después de la primera ejecución (rápida), si guardo el libro de trabajo, lo cierro y lo vuelvo a abrir, la (nueva) primera ejecución nuevamente será muy rápido, pero si hubiera hecho lo mismo excat sin cerrar y volver a abrir, habría sido muy 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

Respuestas a la pregunta(3)

Su respuesta a la pregunta