XL 2016 tableau : macro extention

Sub Test()
Dim T(), R As Range
Set R = ActiveSheet.ListObjects(1).DataBodyRange.Resize(7)
T = R.Value
R.ClearContents
R.Value = T
End Sub

Function GetTableName() As String
    GetTableName = Worksheets(ActiveSheet.Name).ListObjects(1).Name
End Function

Sub Table_Redim()
Dim ran1 As Range
Dim Ran1_Dep, Ran1_Fin As Range

nomtable = GetTableName
Set Ran1_Dep = ActiveSheet.ListObjects(GetTableName).Range.Cells(1, 1)
Set Ran1_Fin = Ran1_Dep.End(xlToRight).End(xlDown)
Ran1_Fin.Select ' ajouté afin de tester le second coin du nouveau range... est faux
Set ran1 = Range(Ran1_Dep, Ran1_Dep.End(xlToRight).End(xlDown))
ActiveSheet.ListObjects(nomtable).Resize ran1
Range(nomtable).Select
End Sub

Sub Verser(TDon())
Dim LO As ListObject, Trop As Long
Set LO = ActiveSheet.ListObjects(1)
Trop = LO.ListRows.Count - UBound(TDon, 1)
If Trop > 0 Then LO.ListRows(UBound(TDon, 1) + 1).Range.Resize(Trop).Delete xlShiftUp
LO.HeaderRowRange.Offset(1).Resize(UBound(TDon, 1)).Value = TDon
End Sub