Effacer les lignes sous condition

Bonsoir a tous et a toute

Voila j aurais besoin d'un coup de main sur la VBA qu'il y a dans la feuille du classeur joint . celle-ci m efface toute les lignes ou les cellules de la ligne sont vide, et je voudrais arrivé que les lignes s efface que quand les cellules des colonnes B a Q reste vide ??si je ne suis pas clair dans mon explication n’hésitai pas

Par avance merci pour l'aide que vous pouvez m apporter

Bonjour,

Sub supprimeligne()
Dim Dlg As Long, i As Long
    Application.ScreenUpdating = False
    With Worksheets("Travaux a faire par Entreprise")
        Dlg = .UsedRange.Rows.Count
        For i = Dlg To 3 Step -1
            Set Plage = Application.Intersect(.Range("B3:Q" & Dlg), .Rows(i))
            If Application.CountA(Plage) = 0 Then .Rows(i).Delete
        Next
    End With
    Set Plage = Nothing
    Application.ScreenUpdating = True
End Sub

A+

Bonsoir frangy

Je te remercie beaucoup mes cela ne fonctionne pas j ai bien mis ta VBA sur le bouton et la rien

Enfin je crois que cet de ma faute je suis mal exprimer je demander que

Phanou a écrit :

que les lignes s efface que quand les cellules des colonnes B a Q reste vide

Si toi ou quelqu'un d'autre peut m aider ce serais sympa

Cordialement

Ps : j ai mis le classeur simplifier en pièce jointe

Si je t’ai bien compris, tu souhaites que la ligne soit supprimée s'il n'y a pas au moins une cellule rouge entre B et Q. Plutôt que chercher à détecter une couleur, il est préférable de reprendre la condition qui fait changer la couleur, à savoir la valeur =0.

Sub supprimeligne()
Dim Dlg As Long, i As Long
    Application.ScreenUpdating = False
    With Worksheets("Travaux a faire par Entreprise")
        Dlg = .UsedRange.Rows.Count
        For i = Dlg To 3 Step -1
            Set Plage = Application.Intersect(.Range("B3:Q" & Dlg), .Rows(i))
            On Error Resume Next
            If Application.Sum(Plage) = 0 Then .Rows(i).Delete
            On Error GoTo 0
        Next
    End With
    Set Plage = Nothing
    Application.ScreenUpdating = True
End Sub

A+

MERCI frangy

Cet exactement ce que je rechercher tu a tout compris

décidément sur le forum il n 'y a que des gens sympathique

Merci encore

je clôture

cordialement