Suppression ligne si une cellule est vide

Bonjour,

Je suis confronté à ce petit problème dont je n'arrive pas à trouver la solution. Il faut dire que mes connaissances en VBA sont assez limitées .

Le fichier présent en PJ se présente comme suit:

- Une première feuille qui répertorie toutes les voiture vendues par marque.

- Une seconde feuille qui répertorie toutes les voiture croisées dans la rue par marque.

Voici le fonctionnement attendu :

Si dans la plage de cellules A2:G1 une ou plusieurs cellules sont vides, alors la ligne ou les lignes correspondantes sont supprimées.

Cela doit s'effectuer uniquement sur ces 2 feuilles (si d'autres feuilles sont créées cela ne doit pas s'appliquer à celles-ci).

Merci d'avance pour votre aide!

Bonjour,

Donc si j'ai bien compris si une des cellules est vide quelque soit la colonne comprise entre A et G, on supprime la ligne.

Avec l'éditeur vba (Alt F11) créez un module et placez y ce code.

Option Explicit

Sub test()
Dim DerLigne, i, j As Long

Application.ScreenUpdating = False

With Sheets("Nombre de voiture vendue")
    For i = 1 To 7
        DerLigne = .Columns(i).Find("*", , , , xlByColumns, xlPrevious).Row + 1
        For j = 2 To DerLigne
            If .Cells(j, i) = "" Then
                .Range("A" & j & ":G" & j).Delete Shift:=xlUp
            End If
        Next j
    Next i
End With

With Sheets("Nombre de voiture dans la rue")
    For i = 1 To 7
        DerLigne = .Columns(i).Find("*", , , , xlByColumns, xlPrevious).Row + 1
        For j = 2 To DerLigne
            If .Cells(j, i) = "" Then
                .Range("A" & j & ":G" & j).Delete Shift:=xlUp
            End If
        Next j
    Next i
End With

Application.ScreenUpdating = True

End Sub

Autre solution plus courte, si vous êtes sûre que vos feuilles reste en 1ère et 2ème position :

Sub test2()
Dim DerLigne, i, j, k As Long

Application.ScreenUpdating = False

For k = 1 To 2
    With Sheets(k)
        For i = 1 To 7
            DerLigne = .Columns(i).Find("*", , , , xlByColumns, xlPrevious).Row + 1
            For j = 2 To DerLigne
                If .Cells(j, i) = "" Then
                    .Range("A" & j & ":G" & j).Delete Shift:=xlUp
                End If
            Next j
        Next i
    End With
Next k

Application.ScreenUpdating = True

End Sub

Parfait Fred35, ta solution fonctionne et c'est exactement ce que je voulais.

J'aurais une dernière petite question qui viens de se rajouter à mon sujet:

Il faudrait en plus que cette macro s'exécute tous les jours à 6h du matin sans aucune intervention de ma pars. Le fichier Excel reste ouvert en permanence donc pas moyen d'exécuter ce genre de solution :

Private Sub Workbook_Open()
    Application.OnTime TimeValue("06:00:00"), "test30"
End Sub

Merci d'avance pour ton aide!

Faudrais pouvoir être certain que le classeur reste ouvert.

dans ThisWorkbook:

Private Sub Workbook_Open()
   Call HeureProg
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   Application.OnTime TimeValue("06:00:00"), "Test30", , False
End Sub

Dans le module placez :

Sub HeureProg()
   Application.OnTime TimeValue("06:00:00"), "Test30"
end sub

et avant le end sub du module Test mettre :

Call HeureProg

Cela à l'air de fonctionner à pars cette ligne qu'il ne veut pas déboguer :

Private Sub Workbook_Open()
       Call HeureProg
    End Sub

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
       Application.OnTime TimeValue("06:00:00"), "Test30", , False
    End Sub

Essayer en modifiant comme ceci :

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Application.OnTime TimeValue("06:00:00"), "Test30", , False
End Sub

Merci à toi Fred35 pour ton aide précieuse!!!

Cela a l'air de fonctionner . A voir dans le temps si cela se confirme

Encore MERCI !