[XL-2007] supression de colonnes totaux 0 dans plusieurs feuilles [Résolu]

[JYPIQ62]

Bonsoir j’ai un petit problème à régler.

Je dois dans plusieurs feuilles d’un même fichier supprimer des colonnes dont la ligne totaux est à zéro. Ligne qui n’est pas toujours située à la même hauteur et dont la valeur n’est pas identique mais toujours reprises dans la colonne A
Sur la feuille 1 il s’agit de : Totaux Salariés

Sur la feuille 2 il s’agit de: Totaux Activités pour l'entreprise

…

Mon second problème c’est que certaines feuilles contiennent le mot totaux en colonne A mais aucune colonne ne doit être supprimée.

J’ai donc trouvé que seules les feuilles contenant le mot SIRET en cellule A4 devaient faire l’objet de ce traitement j’ai donc pensé à la macro suivante :

Code :

1
2
3
4
5
6
7
8
Sub deletecolums0()
 
Dim ws As Worksheet, x As Range
For Each ws In Worksheets
    Set x = ws.Cells.Find("SIRET", , xlValues, xlWhole, , , False)
If Not x Is Nothing Then ws.Columns(x.Column).delete*
Next ws
End Sub

Sauf qu’au lieu de les supprimer* je voudrais au sein de ces colonnes identifier la cellule et donc la ligne contenant le mot totaux

Pour enfin supprimer les colonnes dont la valeur est égale à 0. et pour laquelle je pense utiliser la macro suivante :

Code :

1
2
3
4
5
6
for i =1 to 100 ' 
if cells (2,i).value="0" then
columns(i).Entirecolumn.delete
i=i-1
end if
next i

Si quelqu’un a une solution je suis preneur même si l’approche du problème est différente.
Merci

[jfontaine]

Bonjour,

Je pense que find est un peu lourd pour rechercher un mot qui se trouve dans une seule cellule

Code :

1
2
3
4
5
6
7
 
Dim ws As Worksheet
For Each ws In Worksheets
   If InStr(1, Ws.Range("A4").Value, "SIRET") > 0 Then
       ... Traitement
   End If
Next Ws

[mercatog]

Bonsoir
Proposition commentée

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub DeleteColumnsNull()
Dim LastCol As Integer, i As Integer
Dim Ws As Worksheet
Dim c As Range
 
Application.ScreenUpdating = False
'On boucle sur les feuilles
For Each Ws In Worksheets
    With Ws
        'Si en A4 on a SIRET, c'est que la feuille est bonne
        If InStr(.Range("A4"), "SIRET") > 0 Then
            'On cherche le mot Totaux dans la colonne A
            Set c = .Range("A:A").Find("Totaux", LookIn:=xlValues, lookat:=xlPart)
            'Si est trouvé
            If Not c Is Nothing Then
                'Dernière colonne
                LastCol = .UsedRange.Columns.Count
                'On boucle sur les cellules de la ligne Totaux de droite vers la gauche et on supprime les colonne de total 0
                For i = LastCol To 2 Step -1
                    If .Cells(c.Row, i) = 0 Then .Columns(i).Delete
                Next i
                Set c = Nothing
            End If
        End If
    End With
Next Ws
End Sub

[JYPIQ62]

Impeccable

J'ai juste du ajouter les guillemets à "0" sinon la macro supprime également les colonnes dont la cellule est est vide