XL 2016 Problème de copie de formules sur une insertion de Ligne dans un Tableau

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lr As ListRow, cellsWithFormula As Range
    If Not Intersect(Target, Range("B5")) Is Nothing Then
        On Error Resume Next
        Set lr = ListObjects("Tableau_RAR").ListRows.Add(Alwaysinsert:=True)
        If Not lr Is Nothing And lr.Index > 1 Then
            ' Sélectionner les cellules qui ont des formules sur la
            ' ligne précédent celle qui vient d'être ajoutée
            Set cellsWithFormula = lr.Range.Offset(-1).SpecialCells(xlCellTypeFormulas)
            ' reproduire les formules dans la ligne venant d'être ajoutée
            If Not cellsWithFormula Is Nothing Then
                cellsWithFormula.Offset(1).Formula = cellsWithFormula.Formula
            End If
        End If
        On Error GoTo 0
    End If
End Sub