Autres Suppression de colonnes en fonction du nom de la feuille

Sub supprimer()
    On Error Resume Next
    For Each feuille In Worksheets
        With Sheets(feuille.Name)
            compteur = 0
            For i = 1 To 9
                compteur = compteur + 1
                If InStr(1, feuille.Name, compteur, vbBinaryCompare) = 0 Then
                    .Columns(i + 7).Delete
                    i = i - 1
                End If
                If compteur = 9 Then Exit For
            Next i
        End With
    Next feuille
End Sub

Sub initialisation()
    Application.DisplayAlerts = False
    Sheets("1").Delete
    Sheets.Add(Worksheets(1)).Name = "1"
    For i = 1 To 9
        Cells(1, 7 + i) = i
    Next i
    Sheets("23").Delete
    Sheets.Add(Worksheets(2)).Name = "23"
    For i = 1 To 9
        Cells(1, 7 + i) = i
    Next i
    Sheets("568").Delete
    Sheets.Add(Worksheets(3)).Name = "568"
    For i = 1 To 9
        Cells(1, 7 + i) = i
    Next i
    Sheets("12346789").Delete
    Sheets.Add.Name = "12346789"
    For i = 1 To 9
        Cells(1, 7 + i) = i
    Next i
    Application.DisplayAlerts = True
End Sub

Sub SupprimerColonnes()
Dim w As Worksheet, i%
For Each w In Worksheets
    For i = 9 To 1 Step -1
        If InStr(w.Name, i) = 0 Then w.Columns(7 + i).Delete
Next i, w
End Sub

Sub SupprimerColonnes()
Dim w As Worksheet, i%, sup As Range
For Each w In Worksheets
    For i = 1 To 9
        If InStr(w.Name, i) = 0 Then Set sup = Union(IIf(sup Is Nothing, w.Columns(7 + i), sup), w.Columns(7 + i))
    Next i
    If Not sup Is Nothing Then sup.Delete: Set sup = Nothing
Next w
End Sub