XL 2010 Supprimer le nom de cellules

On Error Resume Next

Dim i as integer
On Error GoTo Erreur
i = 0

Erreur :
i = i + 1


Msgbox "Il y a eu" & i & "erreurs"

Sub Suppression()
    On Error GoTo Erreur
    i = 0
'   Supprime le nom d'une cellule
    For Each r In Selection
        If r.Name <> "" Then
            r.Name.Delete
        End If
Erreur:
    i = i + 1
    Next
    MsgBox "Il y a eu" & i & " erreurs"
End Sub

Sub Suppression()
    On Error GoTo Erreur
    i = 0
'   Supprime le nom d'une cellule
    For Each r In Selection
        If r.Name <> "" Then
            r.Name.Delete
        End If
    Next
    MsgBox "Il y a eu" & i & " erreurs"
    
Erreur:
    i = i + 1
    
End Sub

Sub test()
    Dim c As Range, nb As Long
    For Each c In Selection
        On Error Resume Next
        c.Name.Delete
        If Err Then nb = nb + 1
        On Error GoTo 0
    Next c
    MsgBox nb & " noms absents"
End Sub

On Error GoTo 0

Sub DeleteName()
Dim nName As Name
For Each nName In Names
If Not Intersect(Selection, Range(nName.Name)) Is Nothing Then
nName.Delete
End If
Next nName
'///->D.Hawley|171105|WA///
End Sub

Sub a()
Dim n As Name, i
ActiveCell.Activate 'au cas où la sélection n'est pas un Range
For Each n In ThisWorkbook.Names
    If TypeName(Evaluate(n.Name)) = "Range" Then _
        If Evaluate(n.Name).Parent.Name = Selection.Parent.Name Then _
            If Evaluate(n.Name).Count = 1 Then _
                If Not Intersect(Evaluate(n.Name), Selection) Is Nothing Then n.Delete: i = i + 1
Next
MsgBox IIf(i, i, "Aucun") & " nom" & IIf(i > 1, "s", "") & " supprimé" & IIf(i > 1, "s", "") & " dans la sélection..."
End Sub