Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Autres Suppression de colonnes en fonction du nom de la feuille

JBond13600

XLDnaute Junior
Bonjour le Forum,

Mon problème du jour : Supprimer des colonnes dans chaque feuille d'un classeur en fonction du nom de la feuille.

Dans chaque feuille, les colonnes à supprimer vont de "H" à "P" inclus où "H"=1 ; "I"=2 ; "J"=3 ; "K"=4 ; "L"=5 : "M"=6 ; "N"=7 ; "O"=8 et "P"=9.

Les noms des feuilles se composent uniquement de chiffres de 1 à 9. Exemples : "1" ; "23" ; "568" ; "2489" ; "14578" ... etc... "123456789"

L'objectif serait de supprimer les colonnes correspondantes au chiffres N'APPARAISSANT PAS dans le nom de la feuille et ainsi :

Pour la feuille "1", supprimer les colonnes correspondantes aux chiffres 2 ; 3 ; 4 ; 5 ; 6 ; 7 ; 8 ; 9 et donc les colonnes I ; J ; k ; L ; M ; N ; O et P
Pour la feuille "23" supprimer les colonnes correspondantes aux chiffres 1 ; 4 ; 5 ; 6 ; 7 ; 8 ; 9 et donc les colonnes H ; k ; L ; M ; N ; O et P
Pour la feuille "568" supprimer les colonnes correspondantes aux chiffres 1 ; 2 ; 3 ; 4 ; 7 ; 9 et donc les colonnes H ; I ; J ; K ; N et P
Pour la feuille "12346789" supprimer la colonne correspondante au chiffre 5 et donc la colonne L
Etc...
Pour la feuille "123456789" aucune colonne à supprimer.

Est-ce envisageable ?

Excel 2007

Merci à vous.
 

Ethiryn - Glarilak

XLDnaute Nouveau
Bonjour JBond13600,

Oui cela est tout à fait possible :
Le code que je te montre fait une boucle sur toutes les pages, puis sur les 9 colonnes et supprime les colonnes dont les numéro ne corresponde pas aux chiffres indiquer dans le numéro de page.
La variable compteur permet de ne pas de bien compter les tours de boucle, puisque "i" est décrémenter de 1 chaque fois que l'on supprime une colonne.
VB:
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

Attention les colonnes conservé sont décalé à gauche en partant de la colonne H.

PS : Voici la code qui ma permit de générer les feuilles entre chaque essai, en numérotant les colonnes de 1 à 9 dans la ligne 1, pour bien voir le résultat.

Code:
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
Le code pour générer les feuilles est très très brouillon, à retravailler si tu veux l'utiliser dans un classeur.

Le code que je te présente peut surement être simplifié, mais c'est une solution fonctionnelle.

J’espère avoir pu répondre correctement à la question.

Ethiryn - Glarilak
 

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour le fil, bonjour le forum,

J'y passe des heures et après moultes essais infructueux j'y parviens enfin ! Ô joie... Je retourne pour envoyer ma solution et je lis Job... Ô tristesse !
I' m'énerve... I' m'énerve et i' m'énerve... Voilà !
 

job75

XLDnaute Barbatruc
En supprimant les colonnes en même temps l'exécution sera plus rapide :
VB:
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…