Optimiser la supression de libne en fonction de la valeur

bonjour,

j'aimerai accélérer le code.

supprimer les lignes d'une BD qui fait 80 000 lignes dont la colonne 10 a des valeurs <= 24

Sheets("destock").Activate

For i = [A65000].End(xlUp).Row To 1 Step -1

If Left(Cells(i, 10), 3) <= 24 Then Rows(i).Delete

Next i

le code fonctionne mais c'est lent (58s), si vous avez une idée...

Merci.

Bonjour,

A tester.

Cdlt.

Public Sub Delete_rows()
Dim ws As Worksheet
Dim lastRow As Long, lRow As Long
Dim modCalc As Long
    With Application
        modCalc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    With Worksheets("destock")
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For lRow = lastRow To 1 Step -1
            If Left(.Cells(lRow, 10), 3).Value <= 24 Then .Rows(lRow).Delete
        Next lRow
    End With
    Application.Calculation = modCalc
End Sub

j'ai une erreur sur cette ligne

If Left(.Cells(lRow, 10), 3).Value <= 24 Then .Rows(lRow).Delete

Re,

Et comme ceci ?

If Left(.Cells(lRow, 10), 3).Value <= 24 Then .Cells(lrow,1).EntireRow.Delete

Salut bbto,

Salut Jean-Eric,

On peut savoir quel type de donnée se trouve en [J:J] ?

'
Dim tTab
'
On Error Resume Next
Application.ScreenUpdating = False
'
With Worksheets("destock")
    tTab = .Range("J1:J" & .Range("J" & Rows.Count).End(xlUp).Row).Value
    For x = 1 To UBound(tTab, 1)
        If CDbl(Left(tTab(x, 1), 3)) <= 24 Then tTab(x, 1) = ""
    Next
    .Range("J1").Resize(UBound(tTab, 1), 1).Value = tTab
    .Range("J1").Resize(UBound(tTab, 1), 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlUp
End With
'
Application.ScreenUpdating = True
On Error GoTo 0
'

A+

le code de Jean Eric plante tjs.

la colonne j c'est le nombre de mois ( des chiffres)

le code de curulis57 fonctionne bien .

Merci