Suppression lignes entières

Bonjour,

Je débute en VBA (il faut bien un début...). Je réalise un TCD avec des données présentes dans une seconde feuille de mon classeur.

Je souhaiterai supprimer certaines lignes de ces données qui se composent que de 0 de la colonne Q à la colonne W.

Certe, il m'est très facile de le faire manuellement. les zéros apparaissent lorsque j'applique le filtre "MAISON" sur sur la colonne I. De ce fait il ne me reste plus que les lignes qui se composent de zéros sur les colonnes Q à W et il ne me reste plus qu'à les supprimer.

Cependant je souhaiterai que cela soit automatique...

Voici un exemple de macro (qui ne fontionne pas) :

Sub SuppressionZero ()
Dim cellule
For Each cellule In Worksheets(2).Range("Q:W")
If cellule.Value=0 Then cellule.EntireRow.Delete
Next
End Sub

En espérant que mon explication soit compréhensible...

Merci par avance pour votre retour.

Bonjour.

Pas testé, mais essaye

Sub Lewandowski()
Dim j As Integer
Dim cpt As Integer
Dim i As Integer
    i = 1
Do Until IsEmpty(Worksheets(2).Cells(i, 1))
    cpt = 0
    For j = 17 To 23 Step 1
        If Worksheets(2).Cells(i, j).Value = 0 Then cpt = cpt + 1
    Next j
    If cpt = 7 Then
        Worksheets(2).Rows(i).Delete
    Else
    i = i + 1
Loop
End Sub

Bonne journée.

J'avance un peu... Cette macro fonctionne partiellement :

Sub supp_lignes_zero()
For Each cellule In Range("Q:W")
If cellule.Value = "0" Then cellule.EntireRow.Delete
Next
End Sub

Seulement il me semble que les lignes sont supprimées à partir du moment où un zéro est présent entre les colonnes Q et W.

Or, je souhaiterai supprimer les lignes, si il y a une suite de zéro entre ces colonnes.

Par exemple :

0|0|0|0|0|0|0| => supprimer ligne entière

0|0|1|0|0|0|0| => ne pas supprimer la ligne

Peut être faudrait t'il que j'applique mon filtre "MAISON" à la colonne I en début de macro afin de réduire les données à traiter ?

Je suis dans une cause perdu ? Je n'arrive pas à faire fonctionner ton code...

C'est à dire ? Où est le soucis ? Pourrais-tu joindre un fichier de ce que tu veux histoire qu'on puisse tester nous-même ?

Je n'ai malheureusement pas le droit de partager le fichier car ce sont des informations de mon boulot. (je sais, c'est pas cool de demander de l'aider sans pouvoir un minimum donner de sources...)

Je vais essayer d'être plus claire.

J'ai une feuille de données composée de 3885 lignes. Les lignes, ayant "Maison" pour contenu en colonne A sont composés du chiffre 0 entre les colonnes Q et W.

Je souhaiterai faire une macro permettant de supprimer totalement, les lignes ayant "Maison" en contenu de la colonne A et le chiffre 0 entre la colonne Q et W.

Voici le code qui se rapproche le plus de ce que je souhaite :

Sub supp_lignes_zero()
For Each cellule In Range("Q:W")
If cellule.Value = "0" Then cellule.EntireRow.Delete
Next
End Sub

Cependant, il semblerait que ce code supprime en masse puisque je me retrouve seulement avec 883 lignes après le passage de la macro. Or, seulement une dizaine de lignes devraient être supprimées.

Je suppose que cette macro mérite un peu plus de condition afin de pouvoir cadrer les choses tel que :

" SI les cellules de la colonne A contiennent "Maison" regarder les cellules des colonnes Q à W de la même ligne et SI suite de zéro entre Q et W ALORS supprimer la ligne."

Je ne sais pas si je suis assez claire mais je suis désespéré

Et donc là dedans où est-ce que ça bug ?

Sub Lewandowski()
Dim j As Integer
Dim cpt As Integer
Dim i As Integer
    i = 1
Do Until IsEmpty(Worksheets(2).Cells(i, 1))
    cpt = 0
If Worksheets(2).Cells(i, 1).Value = "MAISON" then
    For j = 17 To 23 Step 1
        If Worksheets(2).Cells(i, j).Value = 0 Then cpt = cpt + 1
    Next j
End if
    If cpt = 7 Then
        Worksheets(2).Rows(i).Delete
    Else
    i = i + 1
Loop
End Sub

Erreur de compilation: boucle sans Do

Oooops, avec le end if c'mieux

    Sub Lewandowski()
    Dim j As Integer
    Dim cpt As Integer
    Dim i As Integer
        i = 1
    Do Until IsEmpty(Worksheets(2).Cells(i, 1))
        cpt = 0
    If Worksheets(2).Cells(i, 1).Value = "MAISON" Then
        For j = 17 To 23 Step 1
            If Worksheets(2).Cells(i, j).Value = 0 Then cpt = cpt + 1
        Next j
    End If
        If cpt = 7 Then
            Worksheets(2).Rows(i).Delete
        Else
            i = i + 1
        End If
    Loop
    End Sub

Alors, plus de message d'erreur mais rien ne se passe. Aucune ligne n'est supprimée.

Je viens de me rendre compte que j'ai oublié de dire que les cellules contenant "Maison" ne contiennent pas que ça. Ca peut être "Maison rose" "Maison bleu"... est ce un problème ?

De plus, la colonne à filtrer n'est plus la A mais la I... (merci patron pour ces changements)

    Sub Lewandowski()
    Dim j As Integer
    Dim cpt As Integer
    Dim i As Integer
        i = 1
    Do Until IsEmpty(Worksheets(2).Cells(i, 1))
        cpt = 0
    If InStr(Worksheets(2).Cells(i, 9).Value,"MAISON") <> 0 Then
        For j = 17 To 23 Step 1
            If Worksheets(2).Cells(i, j).Value = 0 Then cpt = cpt + 1
        Next j
    End If
        If cpt = 7 Then
            Worksheets(2).Rows(i).Delete
        Else
            i = i + 1
        End If
    Loop
    End Sub

MERCIIII

C'est super, ça fonctionne parfaitement, BRAVO pour cette prouesse, ma demande n'étais pas claire et manquait d'un support pour pouvoir t'aider un peu plus.

Un grand merci, heureusement que les Forums existes pour s'entraider.

Bonne journée