Je voudrais ajouter une ligne en recopiant les formules contenues dans la ligne du dessus mais pas les valeurs

sub NouvelleLigneEnDessous()
 
 Dim ZtNumLig As Integer
 Dim ZtDerCol As Integer
 
  ActiveCell.Range("A2").EntireRow.Insert
  ZtNumLig = ActiveCell.Row
  ZtDerCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
  Range(Cells(ZtNumLig, 1), Cells(ZtNumLig, ZtDerCol)).Copy _
    Range(Cells(ZtNumLig + 1, 1), Cells(ZtNumLig + 1, ZtDerCol))
  Application.ScreenUpdating = False
  For i = 1 To ZtDerCol
    If Not Cells(ZtNumLig + 1, i).HasFormula Then
      Cells(ZtNumLig + 1, i).ClearContents
    End If
  Next i
  ActiveCell.Range("A2").Select
 end sub