XL 2021 Effacement de données.

Sub Effacer()
    Dim Bouton As Integer
    Dim FSO As Object
    Dim NomCeClasseur As String
    Dim NomBackUp As String
    Dim k As Integer
 
    'Prompt de confirmation
    Bouton = MsgBox("Confirmer l'effacement des courses ?", vbOKCancel + vbQuestion)
    If Bouton = vbCancel Then Exit Sub
    
    'Prompt de création du BackUp
    Bouton = MsgBox("Créer un fichier BackUp avant l'effacement des courses ?", vbYesNoCancel + vbQuestion)
    If Bouton = vbCancel Then Exit Sub
    
    'Création du BackUp
    If Bouton = vbYes Then
        NomCeClasseur = ThisWorkbook.FullName
        k = InStrRev(NomCeClasseur, ".")
        NomBackUp = Left(NomCeClasseur, k - 1) & _
                    " " & _
                    Format(Now, "dd-mm-aa") & _
                    Mid(NomCeClasseur, k)
                    
        'Si classeur en cours modifié, l'enregistrer
        If Not ThisWorkbook.Saved Then ThisWorkbook.Save
        
        'File System Object
        Set FSO = CreateObject("Scripting.FileSystemObject")
        
        'Copier le classeur en cours sur le BackUp
        FSO.copyfile NomCeClasseur, NomBackUp, True
        
        'Confirmation
        MsgBox "Fichier <" & NomBackUp & "> créé !"
    End If
 
    'Effacement des colonnes relatives aux courses
    With ActiveSheet.ListObjects(NomTableauListeCourses)
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
        .ListRows.Add
        .ListRows(1).Range.Interior.ColorIndex = xlNone
        .ListColumns(TableauListeCourses_NomColonneCatégorie).DataBodyRange.Interior.Color = RGB(253, 233, 217)
        .HeaderRowRange(1).Select
        .DataBodyRange(1, 1).Validation.Delete
        .DataBodyRange(1, 1).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="A,N"
    End With
    
    'Confirmation
    MsgBox "Effacement des courses terminé !"
End Sub