Suppression lignes vides

Bonjour,

Afin d'avoir des données épurées, j'ai fait une macro afin de supprimer les lignes de mon tableau qui ne comportent pas de dates de début (fichier en pièce jointe).

Le problème c'est que sur mon ordinateur la macro est extrêmement lente quand elle s'exécute : presque 10 minutes pour supprimer les lignes sans date de début (dans le fichier j'ai volontairement laissé les lignes sans date de début à des fin de test).

Peut-on imaginer un code qui soit beaucoup plus rapide ?

Merci d'avance pour votre aide.

bonjour nickal,

si c'est important d'avoir les lignes dans la séquence originale, il faut ajouter une colonne auxiliaire, sinon, c'est encore plus facile

Sub supprimer()
     Dim i, iCol, t
     t = Timer
     With Range("consoTX24").ListObject
          i = WorksheetFunction.CountBlank(.ListColumns("Date de début").DataBodyRange)
          If i = 0 Then MsgBox "ok": Exit Sub

          With .ListColumns("colonne auxi")
               iCol = .Index
               With .DataBodyRange
                    .FormulaR1C1 = "=row()"
                    .Value = .Value
               End With
          End With

          With .Range
               .Sort .Range("B1"), Header:=xlYes
          End With

          With .DataBodyRange
               .Offset(.Rows.Count - i).Resize(i).Delete
          End With

          With .Range
               .Sort .Cells(1, iCol), Header:=xlYes
          End With
     End With
     MsgBox "prêt en " & Format(Timer - t, "0.0\s") & vbLf & i & " lignes"
End Sub

Bonjour Bart et merci pour le code qui fonctionne très bien.

Il n'est pas nécessaire d'avoir les lignes dans la séquence originale. Du coup le code serait plus simple et sans besoins de la colonne auxiliaire ?

re,

avec cette macro vous pouvez supprimer la colonne auxiliaire. En plus en trie avec la colonne C et la colonne A (à modifier si cela ne vous plait pas)

Sub Supprimer()
     Dim i, iCol, t
     t = Timer
     Application.screenupdating=false
     With Range("consoTX24").ListObject
          i = WorksheetFunction.CountBlank(.ListColumns("Date de début").DataBodyRange)
          If i = 0 Then MsgBox "aucun vide": Exit Sub

          With .Range
               .Sort key1:=.Range("B1"), order1:=xlAscending, key2:=.Range("A1"), order2:=xlAscending, Header:=xlYes     'trier le tableau avec la colonne "Date Début", alors les cellules vides seronnt en bas
          End With

          With .DataBodyRange
               .Offset(.Rows.Count - i).Resize(i).Delete     'supprimer la plage avec ces cellules vides "date début"
          End With

     End With
     MsgBox "prêt en " & Format(Timer - t, "0.0\s") & vbLf & i & " lignes"
End Sub

Bonjour Bart,

Merci, ça fonctionne parfaitement.

Bonne journée.