Macro suppression de colonne

CB60

XLDnaute Barbatruc
Bonjour,
je cherche à rendre mon code VBA pour supprimer des colonnes plus rapide
J'ai trouvé cette macro de Job, qui fonctionne si je fais feuille par feuille
Code:
Sub SupprimeColonnes()
Dim v, c As Range, sup As Range
v = "x"
For Each c In ActiveSheet.UsedRange.Rows(2).Cells
  If c = v Then Set sup = Union(c, IIf(sup Is Nothing, c, sup))
Next
If Not sup Is Nothing Then sup.EntireColumn.Delete
End Sub
je l'ai donc transformé de cette façon:

Code:
Sub effaceCOL()
Dim f
Dim v, c As Range, sup As Range
v = "x"
For Each f In Array("Result_Tric ", "Result_Finished", "Analyse dimensionnelle", "FT TRE1")
    Sheets(f).Activate
    With Sheets(f)
        Rows("2:2").Copy
        Rows("2:2").PasteSpecial xlPasteValues
    End With
    For Each c In ActiveSheet.UsedRange.Rows(2).Cells
        If c = v Then Set sup = Union(c, IIf(sup Is Nothing, c, sup))
    Next
        If Not sup Is Nothing Then sup.EntireColumn.Delete
Next f
End Sub
afin de boucler sur mes feuilles, la macro que j'ai modifié plante à cet endroit:
Code:
Set sup = Union(c, IIf(sup Is Nothing, c, sup))
erreur d'exécution 1004
Avez vous une idée du pourquoi?
 

youky(BJ)

XLDnaute Barbatruc
Bonjour CB60,
J'ai écris ceci sans tester car pas de fichier exemple.
Si j'ai bien compris . . .
Bruno
VB:
Sub effaceCOL()
Dim f,k as long
Dim v, c As Range
v = "x"
For Each f In Array("Result_Tric ", "Result_Finished", "Analyse dimensionnelle", "FT TRE1")
With Sheets(f)'le . indique le with
  col=.cells(2,256).end(1).row
  .range(.cells(2,1),.cells(2,col)).value=.range(.cells(2,1),.cells(2,col)).value
    For k=1 to col
     If .cells(2,k) = v Then .columns(k).delete : exit for
    Next
End With
Next f
End Sub
 

CB60

XLDnaute Barbatruc
Re
Je met un fichier, au cas ou?
Youky, je n'ai pas reussi à faire fonctionner ta macro, le fichier te permettra peut être de voir pourquoi?
Il y a plein de "ref" dedans, mais le plus important est la structure de la ligne deux
 

Pièces jointes

  • TestExcelD.xls
    546.5 KB · Affichages: 42

CB60

XLDnaute Barbatruc
Oui Youky,
je sais le faire avec une boucle colonne par colonne, mais la macro est longue, ( feuille et colonne)
la façon que Job a fais permet, de boucler sur toutes les colonnes et ensuite supprimer toutes les colonne d'un seul coup, ça vas beaucoup plus vite.
Mais je ne comprend pas ce qui plante
 

job75

XLDnaute Barbatruc
Bonjour CB60, Bruno,

Il faut bien sûr initialiser la variable sup à chaque feuille :
Code:
Set sup =Nothing 'initialise la variable
For Each c In ActiveSheet.UsedRange.Rows(2).Cells
        If c = v Then Set sup = Union(c, IIf(sup Is Nothing, c, sup))
Next
Détail : pourquoi activer chaque feuille ??? En VBA c'est inutile, tout le monde le sait...

Et .Copy/Paste pour ne conserver que les valeurs c'est une méthode de débutant.

A+
 

CB60

XLDnaute Barbatruc
Merci Job, Youki
Je teste cela,
pourquoi j'activais chaque feuille, tout simplement parce que j'ai mis des points d'arrêt dans ma macro, afin de voir ce qui se passe
je dois les enlever des que ça fonctionne

Merci à vous deux d'avoir pris le temps de me répondre,
CA MARCHE, ça se voit que je ni connais rien en macro
 

CB60

XLDnaute Barbatruc
Re
Job, oui, je suis débutant en macro, mais si je ne mets pas le copy/paste, les X passent en "ref" et je n'effaçais pas toutes les cellules, de la façon que tu a réalisé ta macro, je vais tester si c'est encore necessaire
 

job75

XLDnaute Barbatruc
Re,

Le code qui va bien :
Code:
Sub effaceCOL()
Dim v, f, sup As Range, c As Range
v = "x"
For Each f In Array("Result_Tric ", "Result_Finished", "Analyse dimensionnelle", "FT TRE1")
    With Sheets(f).UsedRange
        .Rows(2) = .Rows(2).Value 'supprime les formules
        Set sup = Nothing 'initialise la variable
        For Each c In .Rows(2).Cells
            If c = v Then Set sup = Union(c, IIf(sup Is Nothing, c, sup))
        Next
        If Not sup Is Nothing Then sup.EntireColumn.Delete
    End With
Next
End Sub
Détail : pourquoi un espace après Result_Tric ???

Edit : s'il n'y a pas d'autres lignes que la 2ème ligne à traiter :
Code:
Sub effaceCOL()
Dim v, f, sup As Range, c As Range
v = "x"
For Each f In Array("Result_Tric ", "Result_Finished", "Analyse dimensionnelle", "FT TRE1")
    With Sheets(f).UsedRange.Rows(2)
        .Value = .Value 'supprime les formules
        Set sup = Nothing 'initialise la variable
        For Each c In .Cells
            If c = v Then Set sup = Union(c, IIf(sup Is Nothing, c, sup))
        Next
        If Not sup Is Nothing Then sup.EntireColumn.Delete
    End With
Next
End Sub
A+
 
Dernière édition:

Discussions similaires

Réponses
7
Affichages
292

Statistiques des forums

Discussions
311 725
Messages
2 081 945
Membres
101 849
dernier inscrit
florentMIG