Macro suppression de colonne si condition, sauf la première colonne

[fran6]

Bonjour

Je suis débutant et je poste pour la première fois sur le forum .
J'extrais des données que je colle dans une feuille.
Les données de la colonne A sont répétées plusieurs fois dans la feuille de façon aléatoire
Je souhaites conserver les données de la colonne A et supprimer autres colonnes contenant les mêmes données
Je cherche donc désespérément à faire une macro qui tout en conservant la colonne A supprime les colonnes redondante
Il convient de supprimer les colonnes dont la cellule située sur la 3éme ligne contient le terme"00*". (exemple 003-xx)
Sub test()
Dim Cel As Range
Do
Set Cel = Cells.Find(What:="00*", LookIn:=xlFormulas, LookAt:=xlWhole)
If Cel Is Nothing Then
Exit Sub
Else
Columns(Cel.Column).Delete
End If
End Sub

Cette macro fonctionne .... mais supprime aussi la colonne A !!!
Je vous remercie pour votre indulgence dans les explications d'une part et pour d'autre part la macro qui j'en suis convaincu ne doit pas être au "top"
Merci pour votre aide
Fran6

 

[tototiti2008]

Re : Macro suppression de colonne si condition, sauf la première colonne

Bonjour fran6,

Bienvenue sur XLD,

Cette macro fonctionne .... mais supprime aussi la colonne A !!!

Avec un Do sans Loop, j'ai du mal à croire que ça fonctionne
Pourrais-tu nous fournir un fichier exemple et expliquer le résultat attendu à cette macro dans ce même fichier ?

 

[fran6]

Re : Macro suppression de colonne si condition, sauf la première colonne

Bjr, merci pour ton attention et surtout pour ton indulgence
Ci joint (en espérant que le fichier et bien joint ) un exemple du résultat attendu
fran6

 

[fran6]

Re : Macro suppression de colonne si condition, sauf la première colonne

Oups, effectivement j'avais oublié de copier le Loop dans mon 1r message

Sub test()
Dim Cel As Range
Do
Set Cel = Cells.Find(What:="00*", LookIn:=xlFormulas, LookAt:=xlWhole)
If Cel Is Nothing Then
Exit Sub
Else
Columns(Cel.Column).Delete
End If
Loop
End Sub

 

[tototiti2008]

Re : Macro suppression de colonne si condition, sauf la première colonne

Re,

un essai

Sub test()
Dim Cel As Range, Adr As String, Adr2 As String
    Set Cel = Cells.Find(What:="00*", LookIn:=xlFormulas, LookAt:=xlWhole)
    If Cel Is Nothing Then Exit Sub
    Adr = Cel.Address
    Do
        If Cel.Column <> 1 Then
            Adr2 = Cel.Offset(0, -1).Address
            Cel.EntireColumn.Delete
            Set Cel = Range(Adr2)
        End If
        Set Cel = Cells.FindNext(Cel)
    Loop Until Cel.Address = Adr Or Cel Is Nothing
End Sub

et surtout pour ton indulgence

toujours, on m'appelle l'indulgent sur le forum

 

[fran6]

Re : Macro suppression de colonne si condition, sauf la première colonne

Respect môssieur l'Indulgent !!! Un grand merci pour ta réponse ça fonctionne exactement comme je le souhaitais
Serait il possible de me commenter la macro que je comprenne pourquoi je n'y arrivais pas depuis 2 jours ... j'avoue que ça commençais à me prendre la tête.
Bonne journée et au plaisir d'échanger encore avec toi sur ce forum bien sympa
Fran6

 

[tototiti2008]

Re : Macro suppression de colonne si condition, sauf la première colonne

Re,


Version commentée

Sub test()
Dim Cel As Range, Adr As String, Adr2 As String
    'Recherche de la première cellule commençant par "00"
    Set Cel = Cells.Find(What:="00*", LookIn:=xlFormulas, LookAt:=xlWhole)
    'Si pas trouvé, il n'y en a pas alors c'est fini
    If Cel Is Nothing Then Exit Sub
    'sinon on note l'adresse de la 1ère trouvée
    Adr = Cel.Address
    Do
        'si la colonne de la cellule trouvée n'est pas 1 (pas A)
        If Cel.Column <> 1 Then
            'on note l'adresse de la cellule une colonne avant
            Adr2 = Cel.Offset(0, -1).Address
            'on supprime la colonne
            Cel.EntireColumn.Delete
            'On affecte la cellule Cel à la cellule une colonne avant
            Set Cel = Range(Adr2)
        End If
        'On recherche la prochaine cellule correspondant aux critères à partir de la dernière cellule trouvée
        Set Cel = Cells.FindNext(Cel)
    Loop Until Cel.Address = Adr Or Cel Is Nothing 'jusqu'à ce que la prochaine cellule ait la même adresse que la première ou qu'on ne trouve plus rien
End Sub

pour la partie

            'on note l'adresse de la cellule une colonne avant
            Adr2 = Cel.Offset(0, -1).Address
            'on supprime la colonne
            Cel.EntireColumn.Delete
            'On affecte la cellule Cel à la cellule une colonne avant
            Set Cel = Range(Adr2)

ça a l'air un peu bizarre mais comme on supprime la colonne, Cel fait référence à une cellule qui n'existe plus, d'où la référence à cellule une colonne avant

 

[fran6]

Re : Macro suppression de colonne si condition, sauf la première colonne

Bonjour

Une difficulté avec la macro, affichage
"erreur d'execution 91" Variable objet ou variable bloc With non définie.
Affichage de la dernière ligne de commande en surligange jaune
Merci de votre aide, je pédale grave

Dim Cel As Range, Adr As String, Adr2 As String
Set Cel = Cells.Find(What:="00*", LookIn:=xlFormulas, LookAt:=xlWhole)
If Cel Is Nothing Then Exit Sub
Adr = Cel.Address
Do
If Cel.Column <> 1 Then
Adr2 = Cel.Offset(0, -1).Address
Cel.EntireColumn.Delete
Set Cel = Range(Adr2)
End If
Set Cel = Cells.FindNext(Cel)
Loop Until Cel.Address = Adr Or Cel Is Nothing

 

[tototiti2008]

Re : Macro suppression de colonne si condition, sauf la première colonne

Bonjour fran6,

Là, mes pouvoirs de devin sont à leur limite
Peux-tu nous poster un fichier exemple qui provoque l'erreur ?

 

[fran6]

Re : Macro suppression de colonne si condition, sauf la première colonne

Slt, merci de ta réactivité
Ci joint une feuille test. En fait, dans mon test de ce jour je récupère d'autres données (par rapport à hier) et je m'aprecois qu'une fois la mise en page terminée (suppression de colonne vide) il reste me une colonne vide à gauche (A). Je crois que le bug vient de là.

 

[tototiti2008]

Re : Macro suppression de colonne si condition, sauf la première colonne

Re,

Oui, en effet, difficile de lire l'adresse d'une cellule qui n'existe pas...

Essaye

Sub index()

Dim Cel As Range, Adr As String, Adr2 As String
    Set Cel = Cells.Find(What:="00*", LookIn:=xlFormulas, LookAt:=xlWhole)
    If Cel Is Nothing Then Exit Sub
    Adr = Cel.Address
    Do
        If Cel.Column <> 1 Then
            Adr2 = Cel.Offset(0, -1).Address
            Cel.EntireColumn.Delete
            Set Cel = Range(Adr2)
        End If
        Set Cel = Cells.FindNext(Cel)
        If Not Cel Is Nothing Then
            If Cel.Address = Adr Then Set Cel = Nothing
        End If
    Loop Until Cel Is Nothing
End Sub

 

[fran6]

Re : Macro suppression de colonne si condition, sauf la première colonne

désolé mais ça ne me réccupère pas la colonne de code

 

[tototiti2008]

Re : Macro suppression de colonne si condition, sauf la première colonne

Re,

désolé mais ça ne me réccupère pas la colonne de code

euh... je ne comprend pas...

 

[fran6]

Re : Macro suppression de colonne si condition, sauf la première colonne

Je m'exprime certainement mal (du probablement à mon grand âge) sur le fichier exemple je souhaites avec la macro conserver la colonne en rouge et supprimer les colonnes jaune
Désolé pour ces complications et merci de ton aide

 

[tototiti2008]

Re : Macro suppression de colonne si condition, sauf la première colonne

Re,

Ahh, ça ?
Ah ben oui, le code ne conserve que la colonne A
Comment déterminer où elle se trouve ?
C'est toujours la première qui contient des données ?
Si non, explique la "règle" qui permettra de la déterminer