Bonjour Kiko, le Forum
voila qui me donne l'occasion d'adapter mon programme de suppression de ligne à la suppression de colonnes alors je ne résiste pas.
Prét à utiliser pour toi, tu peux préciser la cellule de fin de test si tu ne veux pas tester toutes les colonnes.
Cordialement, A+
Sub Supprimer_Colonnes()
'définition des variables
Dim Tab_Cells As Variant, Tab_Column() As Integer, Mem_Column As Long
Dim Cellule_Debut As Range, Cellule_Fin
Dim Deb_Tab As Long, Compteur As Long, Compteur2 As Long
'désactivation de l'affichage écran pour gagner en rapidité
Application.ScreenUpdating = False
With ActiveSheet
'indiquer ici la cellule de début de test
Set Cellule_Debut = .Range("A13")
'indiquer ici la cellule de début de test ou laisser pour la dernière cellule de la ligne
Set Cellule_Fin = Range("A" & Cellule_Debut.Row).Offset(0, Range("A1").SpecialCells(xlCellTypeLastCell).Column - 1)
'mémorise la colonne de début du tableau de valeurs
Mem_Column = Cellule_Debut.Column - 1
'passe les valeurs de cellules au tableau de valeurs
Tab_Cells = .Range(Cellule_Debut.Address & ":" & Cellule_Fin.Address).Value
'initialise les compteurs
Compteur = 0
'boucle sur la longueur du tableau
For Compteur2 = 1 To .Range(Cellule_Debut.Address & ":" & Cellule_Fin.Address).Columns.Count
'indiquer ici la valeur du test
If Tab_Cells(1, Compteur2) = "toto" Then
Compteur = Compteur + 1
'on redimensionne en conservant les valeurs
ReDim Preserve Tab_Column(1 To Compteur) As Integer
Tab_Column(Compteur) = Compteur2 + Mem_Column
End If
Next Compteur2
'on efface les colonnes détectées en partant de la fin
For Compteur2 = Compteur To 1 Step -1
'pour test
'Application.ScreenUpdating = True
'.Columns(Tab_Column(Compteur2)).Select
'MsgBox Tab_Column(Compteur2)
.Columns(Tab_Column(Compteur2)).Delete Shift:=xlLeft
Next Compteur2
.Range("A1").Select
End With
End Sub