VBA: Ajouter une ligne en fin de tableau en reprenant certaines données de la dernière ligne

Sub Suppression()
ligne = Range("B65000").End(xlUp).Row
Rows(ligne).Delete
End Sub
Sub nouvelle_ligne()
ligne = Range("B65000").End(xlUp).Offset(1, 0).Row
Range("b" & ligne) = Now
Range("d" & ligne) = Range("d" & ligne - 1) + 1
End Sub

Sub AjoutAnomalie()
  With Sheets("DATABASE").ListObjects("Tableau_DATABASE")
    .ListRows.Add AlwaysInsert:=True
    .ListColumns("Date").DataBodyRange(.ListRows.Count) = Date
   .ListColumns("N° Dossier").DataBodyRange(.ListRows.Count) = .ListColumns("N° Dossier").DataBodyRange(.ListRows.Count - 1)
   .ListColumns("Modèle camion/nacelle").DataBodyRange(.ListRows.Count) = .ListColumns("Modèle camion/nacelle").DataBodyRange(.ListRows.Count - 1)
   .ListColumns("Chef d'équipe").DataBodyRange(.ListRows.Count) = .ListColumns("Chef d'équipe").DataBodyRange(.ListRows.Count - 1)
   .ListColumns("Camion double").DataBodyRange(.ListRows.Count) = .ListColumns("Camion double").DataBodyRange(.ListRows.Count - 1)
   .ListColumns("Non-conformité").DataBodyRange(.ListRows.Count) = .ListColumns("N° Dossier").DataBodyRange(.ListRows.Count) & "Texte prédéfini..."
   .ListColumns("Chef de pont").DataBodyRange(.ListRows.Count) = .ListColumns("Chef de pont").DataBodyRange(.ListRows.Count - 1)
   .ListColumns("Monteur").DataBodyRange(.ListRows.Count) = .ListColumns("Monteur").DataBodyRange(.ListRows.Count - 1)
   .ListColumns("Bleu").DataBodyRange(.ListRows.Count) = .ListColumns("Bleu").DataBodyRange(.ListRows.Count - 1)
   .ListColumns("Controleur").DataBodyRange(.ListRows.Count) = .ListColumns("Controleur").DataBodyRange(.ListRows.Count - 1)
   .ListColumns("Klubb FR").DataBodyRange(.ListRows.Count) = .ListColumns("Klubb FR").DataBodyRange(.ListRows.Count - 1)
   .ListColumns("Opérateur Qualité").DataBodyRange(.ListRows.Count) = .ListColumns("Opérateur Qualité").DataBodyRange(.ListRows.Count - 1)
  End With
End Sub

Option Explicit

Dim lo As ListObject
Dim lr As ListRow
Dim n As Long

'Point 1
Public Sub InsertRowInTable_1()
    Application.ScreenUpdating = False
    Set lo = ActiveSheet.ListObjects(1)
    Set lr = lo.ListRows.Add(AlwaysInsert:=True)
    n = lo.ListRows.Count
    With lr.Range
        .Cells(1, 1).Value = Date
        .Cells(1, 3).Value = lo.Range.Cells(n, 3) + 1
        .Cells(1, 7).Value = Format(n, "00") & " - Saisir non-conformité"
    End With
    Set lr = Nothing: Set lo = Nothing
End Sub

'Point 2
Public Sub InsertRowInTable_2()
Dim tbl As Variant, v As Variant
    Application.ScreenUpdating = False
    tbl = Array(4, 5, 6, 9, 10, 11, 12, 13, 14)
    Set lo = ActiveSheet.ListObjects(1)
    Set lr = lo.ListRows.Add(AlwaysInsert:=True)
    n = lo.ListRows.Count
    With lr.Range
        .Cells(1, 1).Value = Date
        .Cells(1, 3).Value = lo.Range.Cells(n, 3) + 1
        .Cells(1, 7).Value = Format(n, "00") & " - Saisir non-conformité"
        For Each v In tbl
            .Cells(1, v).Value = lo.Range.Cells(n, v)
        Next
    End With
    Set lr = Nothing: Set lo = Nothing
End Sub
'Réinitialisation tableau en conservant les formules
'et la mise en forme.
Public Sub ResetTable()
    Application.ScreenUpdating = False
    Set lo = ActiveSheet.ListObjects(1)
    If Not lo.DataBodyRange Is Nothing Then lo.DataBodyRange.Delete
    Set lo = Nothing
End Sub

Public Sub Lookup()
Dim Msg As String, Title As String, Answer As String, firstAddress As String
Dim rCell As Range
Dim nn As Long
    Application.ScreenUpdating = False
    Msg = "Veuillez saisir le numéro de dossier"
    Title = "Recherche"
    Answer = InputBox(Msg, "title")
    If Answer = "" Then Exit Sub
    Set lo = ActiveSheet.ListObjects(1)
    'With lo
        '.Sort.SortFields.Add .ListColumns(1).DataBodyRange, xlSortOnValues, xlAscending
        '.Sort.SortFields.Add .ListColumns(3).DataBodyRange, xlSortOnValues, xlAscending
        '.Sort.Apply
        '.Sort.SortFields.Clear
    'End With
    With lo.ListColumns(3).DataBodyRange
        Set rCell = .Find(what:=Answer, LookIn:=xlValues, lookat:=xlWhole)
        If Not rCell Is Nothing Then
            firstAddress = rCell.Address
            n = rCell.Row
            Do
                If rCell.Row > n Then n = rCell.Row
                Set rCell = .FindNext(rCell)
            Loop While Not rCell Is Nothing And rCell.Address <> firstAddress
        End If
    End With
    n = n - lo.HeaderRowRange.Row
    Set lr = lo.ListRows.Add(n + 1)
    nn = lo.ListRows.Count
    With lr.Range
        .Cells(1, 1).Value = Date
        .Cells(1, 3).Value = lo.Range.Cells(n - 1, 3)
        .Cells(1, 7).Value = Format(nn, "00") & " - Saisir non-conformité"
    End With
    Set rCell = Nothing: Set lr = Nothing: Set lo = Nothing
End Sub