Supprimer des lignes

Bonjour,

J'ai un fichier qui contient environ 14 000 lignes et je veux effacer les lignes antérieurs à une da

te que je définis.

Le problème est que si j'ai beaucoup de lignes à effacer le temps est très long.

Je vous fais parvenir le fichier et j'aimerais savoir s'il il a une façon de maximiser l'effacement des lignes.

Merci,

Oiseau bleu

Bonjour Oiseaubleu,

Une solution consiste à filtrer les lignes concernées et à les supprimer

Sub EffacerLigne()
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  With ThisWorkbook.Sheets("Donnees heures")
    ' Filter sur les dates antérieure à celle inscrite
    .ListObjects("Basedonnées").Range.AutoFilter Field:=6, Criteria1:="<" & Format(.Range("E3"), "mm/dd/yyyy")
    ' Sélectionner la 1ère cellule visible en dessous de l'entête
    .Range("Basedonnées[[#Headers],[Date]]").Offset(1, 0).Select
    ' Sélectionner toutes les lignes visibles
    .Range(Selection, Selection.End(xlDown)).Select
    ' Supprimer toutes les lignes
    Selection.EntireRow.Delete
    ' Afficher les lignes restantes
    .ShowAllData
  End With
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

A voir

@+

Bonjour à toutes et tous,

Une autre proposition basée aussi sur la méthode Range.AutoFilter.

Cdlt.

Public Sub DeleteRowsInTable()
Dim lo As ListObject, sDate As String, rngData As Range
    Application.ScreenUpdating = False
    With Worksheets("Donnees heures")
        Set lo = .ListObjects("Basedonnées")
        sDate = Format(.Cells(3, 5).Value2, "mm/dd/yyyy")
    End With
    With lo
        If .ShowAutoFilter Then .AutoFilter.ShowAllData
        .Range.AutoFilter field:=6, Criteria1:="<" & sDate
        On Error Resume Next
        Set rngData = .DataBodyRange.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        lo.Range.AutoFilter field:=6
    End With
    If rngData Is Nothing Then
        MsgBox "Il n'y a pas de données à supprimer !...", 64, "Informations"
    Else
        rngData.Delete
    End If
End Sub

Super cela fonctionne très bien.

C'est rapide et efficace.

Merci à vous pour vos réponses,

Oiseau bleu