Garder le contenu de la page après un ajout de lignes dans un tableaux

Bonjour,

Dans une feuille j'ai un tableau contenant des sections de lignes et en dessous du tableau j'ai d'autres données. Un bouton permet d'ajouter d'autres sections de lignes dynamiquement dans le tableau (une fonction vba "AddANewPrivateExpert" est appelée).

Voici la fonction:

Sub AddANewPrivateExpert()

        'Sheets("Estimated Costs").Unprotect Password:="000"

        'ActiveCell.Locked = False

        'Sheets("Estimated Costs").Protect Password:="000"

    Dim DerniereLigne As Long
    Dim Sh As Worksheet

    Set Sh = ActiveSheet

    With Sh
         DerniereLigne = .Cells(.Rows.Count, "F").End(xlUp).Row
         .Range(.Cells(DerniereLigne + 1, "A"), .Cells(DerniereLigne + 3, "F")).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
         .Range(.Cells(DerniereLigne - 3, "A"), .Cells(DerniereLigne, "F")).Copy Destination:=.Cells(DerniereLigne + 1, "A")
         .Range(.Cells(DerniereLigne + 1, "A"), .Cells(DerniereLigne + 1, "F")).Borders(xlEdgeTop).Weight = xlMedium
         .Cells(DerniereLigne + 1, "A") = .Cells(DerniereLigne - 3, "A") + 1
         .Range(.Cells(DerniereLigne + 2, "D"), .Cells(DerniereLigne + 3, "D")).ClearContents
    End With
    Set Sh = Nothing

End Sub

L' ajout se fait bien mais après plusieurs ajout successifs, les données en dessous du tableau finissent par être écrasées par les nouvelles section du tableau. Pourriez-vous m'aider pour faire en sorte que le contenu en dessous du tableau soit toujours présent ?

Voici le fichier:

Le fichier est verrouillé avec le mot de passe: 000

Merci d'avance pour votre aide

Bonjour,

Peut-être que cette ligne est à modifier ainsi :

.Range(.Cells(DerniereLigne + 1, "A"), .Cells(DerniereLigne + 4, "F")).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

En effet, on insère 3 lignes pour en coller 4. Donc un jour on se fait rattraper...

Cdlt,