XL 2016 message d'erreur

Private Sub CommandButton1_Click()

Dim MyLastRow As Integer
Dim UserAnswer As VbMsgBoxResult
Dim tbl As ListObject
Dim ws As Worksheet
Dim sortcolumn As Range

UserAnswer = MsgBox("• Confirmez-vous cet ajout?", vbYesNo + vbQuestion, "Confirmation!")
    If CStr(UserAnswer) = CStr(False) Then Exit Sub
    If UserAnswer = vbCancel Then Exit Sub
    If UserAnswer = vbNo Then Exit Sub
    
Set ws = Application.ThisWorkbook.Worksheets("liste_vin")
  
With ws
    .Activate
    MyLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' ajout des données concernant le vin   Zone Jaune du tableau colonne 1 à 7
    .Cells(MyLastRow, 1) = CBB2.Value & " " & CBB3.Value & " " & CBB4.Value & " " & CBB6 ' Appellation + classement + climat + année
    .Cells(MyLastRow, 2) = CBB1.Value                                                    ' Région
    .Cells(MyLastRow, 3) = CBB5.Value                                                    ' Couleur
    .Cells(MyLastRow, 4) = CBB7.Value                                                    ' Nbre achat
    .Cells(MyLastRow, 5) = CBB11.Value                                                   ' Contenance
    .Cells(MyLastRow, 6) = CBB6.Value                                                    ' Millesime
    .Cells(MyLastRow, 7) = CBB9.Value & "." & CBB10.Value                   ' Rangement
    .Cells(MyLastRow, 18) = CBB8.Value                                                   ' Région
'  ajout des données concernant le domaine    Zone rose  du tableau colonne 8 à 12
    .Cells(MyLastRow, 8) = TxtDomaine.Value                                              ' Nom du domaine
    .Cells(MyLastRow, 9) = TxtAdresse & " " & TxtCp.Value & " " & TxtVille.Value         ' adresse
    .Cells(MyLastRow, 10) = TxtTel.Value                                                 'Telephone
    .Cells(MyLastRow, 11) = TxtMail.Value                                                ' Mail
    .Cells(MyLastRow, 12) = TxtInternet.Value                                            ' internet

' ajout des donnees concernant les caracteristiques du vin
    .Cells(MyLastRow, 13) = TxtInformation.Value
    .Cells(MyLastRow, 14) = TxtQuemangerAvec.Value
    .Cells(MyLastRow, 15) = TxtCaracteristique.Value
    .Cells(MyLastRow, 16) = TxtServiceVin.Value
    .Cells(MyLastRow, 17) = TxtConservation.Value
End With

'Classement des vins par annee
Set tbl = ws.ListObjects("Tableau2")
Set sortcolumn = Range("Tableau2[Millesime]")

With tbl.Sort
   .SortFields.Clear
   .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
   .Header = xlYes
   .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
   .Apply
End With

If Not sortcolumn Is Nothing Then Set sortcolumn = Nothing
If Not tbl Is Nothing Then Set tbl = Nothing
If Not ws Is Nothing Then Set ws = Nothing

End Sub

Public Function TableExists(tableName As String, ws As Worksheet) As Boolean ' DÉTERMINER SI LE NOM DE LA TABLE EXISTE
    On Error GoTo TableExists_Error
    If ws.ListObjects(tableName).Name = vbNullString Then
    End If
   
    TableExists = True
   
    On Error GoTo 0
    Exit Function
   
TableExists_Error:
        TableExists = False
End Function

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean ' Déterminer si un nom de feuille de calcul existe dans ce classeur
    On Error Resume Next
    WorksheetExists = (ThisWorkbook.Sheets(WorksheetName).Name <> "")
    On Error GoTo 0
End Function

Private Sub CommandButton1_Click()
    If Not WorksheetExists("liste_vin") Then ' Déterminer si un nom de feuille de calcul existe dans ce classeur (MACRO)
        MsgBox "Erreur critique:" & vbCrLf & vbCrLf & "• Base de données introuvable!", vbCritical, "Information!"
        Exit Sub
    End If
   
    Dim ws As Worksheet
    Dim tableName As String
    Dim xAdd(17)
    Dim UserAnswer As VbMsgBoxResult
    Dim tbl As ListObject
    Dim sortcolumn As Range
   
    UserAnswer = MsgBox("• Confirmez-vous cet ajout?", vbYesNo + vbQuestion, "Confirmation!")
        If CStr(UserAnswer) = CStr(False) Then Exit Sub
        If UserAnswer = vbCancel Then Exit Sub
        If UserAnswer = vbNo Then Exit Sub
   
    tableName = "Tableau2"
    Set ws = Application.ThisWorkbook.Worksheets("liste_vin")
   
    If Not TableExists(tableName, ws) Then '  table exist (MACRO)
        MsgBox "Accès refusé: " & vbCrLf & vbCrLf & " • Base de données non trouvée, vérifiez si elle a déjà été créée! ", vbCritical, "Information!"
        If Not ws Is Nothing Then Set ws = Nothing
        Exit Sub
    End If
   
    ' ajout des données concernant le vin   Zone Jaune du tableau colonne 1 à 7
    xAdd(0) = Me.CBB2.Value & " " & Me.CBB3.Value & " " & Me.CBB4.Value & " " & Me.CBB6.Value   ' Appellation + classement + climat + année
    xAdd(1) = Me.CBB1.Value                                                                     ' Région
    xAdd(2) = Me.CBB5.Value                                                                     ' Couleur
    xAdd(3) = Me.CBB7.Value                                                                     ' Nbre achat
    xAdd(4) = Me.CBB11.Value                                                                    ' Contenance
    xAdd(5) = CBB6.Value                                                                        ' Millesime
    xAdd(6) = Me.CBB9.Value & "." & Me.CBB10.Value                                              ' Rangement
    xAdd(17) = Me.CBB8.Value                                                                    ' Région
    '  ajout des données concernant le domaine    Zone rose  du tableau colonne 8 à 12
    xAdd(7) = Me.TxtDomaine.Value                                                               ' Nom du domaine
    xAdd(8) = Me.TxtAdresse.Value & " " & Me.TxtCp.Value & " " & Me.TxtVille.Value              ' adresse
    xAdd(9) = Me.TxtTel.Value                                                                   ' Telephone
    xAdd(10) = Me.TxtMail.Value                                                                 ' Mail
    xAdd(11) = Me.TxtInternet.Value                                                             ' internet
    ' ajout des donnees concernant les caracteristiques du vin
    xAdd(12) = Me.TxtInformation.Value
    xAdd(13) = Me.TxtQuemangerAvec.Value
    xAdd(14) = Me.TxtCaracteristique.Value
    xAdd(15) = Me.TxtServiceVin.Value
    xAdd(16) = Me.TxtConservation.Value
   
    AddRecordTableRow tableName, xAdd
   
    'Classement des vins par annee
    With ws.Range("Tableau2")
     LastRow = .Cells(.Rows.Count, 6).End(xlUp).Row
    End With
   
    Set tbl = ws.ListObjects("Tableau2")
    Set sortcolumn = ws.Range("F8:F" & LastRow)
   
    With tbl.Sort
       .SortFields.Clear
       .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
       .Apply
    End With
   
    If Not sortcolumn Is Nothing Then Set sortcolumn = Nothing
    If Not tbl Is Nothing Then Set tbl = Nothing
    If Not ws Is Nothing Then Set ws = Nothing
End Sub

Private Sub AddRecordTableRow(XtableName As String, values() As Variant)
    Dim ws As Worksheet
    Dim table As ListObject
    Dim col As Integer
    Dim LastRow As Integer, lastcol As Integer
   
    Set ws = Application.ThisWorkbook.Worksheets("liste_vin")
   
    With ws
        .Activate
        Set table = .ListObjects.Item(XtableName)
       
        With .Range("Tableau2")
            LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            Debug.Print LastRow
            lastcol = .Columns.Count
            Debug.Print lastcol
        End With
   
        If table.ListRows.Count > 0 Then
            For col = 1 To lastcol
                If Trim(CStr(.Cells(LastRow, col).Value)) <> "" Then
                    table.ListRows.Add AlwaysInsert:=True
                    Exit For
                End If
            Next col
        Else
            table.ListRows.Add AlwaysInsert:=True
        End If
   
        LastRow = LastRow + 1
       
        For col = 1 To lastcol
            If col <= UBound(values) + 1 Then .Cells(LastRow, col) = values(col - 1)
        Next col
   
    End With
   
    MsgBox "• Nouveau record de vin ajouté!", vbInformation, "Information!"
   
    If Not table Is Nothing Then Set table = Nothing
    If Not ws Is Nothing Then Set ws = Nothing
End Sub