XL 2019 Supprimer lignes après échéance

[KTM]

Bonjour chers tous
Je voudrais supprimer les lignes pour lesquelles l'échéance est dépassée de 28 jours.
Mon code si dessous fonctionne avec plusieurs lignes mais avec une seule ligne j'ai l'impression que quelque chose ne va pas.
Voir mon fichier joint.

Sub trier()
With ActiveSheet
  If .Range("AW1") = "AUXIL" Then .Columns("AW:AW").Delete
 .Columns("AW:AW").Insert: .Range("AW1") = "AUXIL"
  With .Range("AM2:BA" & .Range("AM" & Rows.Count).End(xlUp).Row)
     .Sort key1:=.Cells(2, 3), order1:=xlAscending, Header:=xlNo
     .Columns(11).FormulaR1C1 = "=IF((R2C37-RC[1])>=R1C37,"""",ROW())"
     .Columns(11).Value = .Columns(11).Value
     .Sort key1:=.Cells(2, 11), order1:=xlAscending, Header:=xlNo
     On Error Resume Next
      Intersect(.Columns(11).SpecialCells(xlCellTypeBlanks).EntireRow, .Rows).Clear
  End With
  If .Range("AW1") = "AUXIL" Then .Columns("AW:AW").Delete
End With
End Sub

 

[job75]

Bonjour KTM,

Au lieu de baser les suppressions sur les cellules vides basez-les sur les valeurs d'erreur :

Sub trier()
With ActiveSheet
    With .Range("AM2:BA" & .Range("AM" & .Rows.Count).End(xlUp).Row)
        If .Row < 2 Then Exit Sub 'sécurité
        .Columns(11).EntireColumn.Insert 'colonne auxiliaire
        .Columns(11).FormulaR1C1 = "=IF((R2C37-RC[1])>=R1C37,""#N/A"",ROW())"
        .Columns(11).Value = .Columns(11).Value
        .Sort key1:=.Cells(1, 11), order1:=xlAscending, Header:=xlNo
         On Error Resume Next
        Intersect(.Columns(11).SpecialCells(xlCellTypeConstants, 16).EntireRow, .Rows).Clear
        .Columns(11).EntireColumn.Delete
    End With
End With
End Sub

Sur la 2ème feuille il n'y aura pas de problème s'il n'y a pas de #N/A en ligne 2.

A+

 

[KTM]

Bonjour KTM,

Au lieu de baser les suppressions sur les cellules vides basez-les sur les valeurs d'erreur :

Sub trier()
With ActiveSheet
    With .Range("AM2:BA" & .Range("AM" & .Rows.Count).End(xlUp).Row)
        If .Row < 2 Then Exit Sub 'sécurité
        .Columns(11).EntireColumn.Insert 'colonne auxiliaire
        .Columns(11).FormulaR1C1 = "=IF((R2C37-RC[1])>=R1C37,""#N/A"",ROW())"
        .Columns(11).Value = .Columns(11).Value
        .Sort key1:=.Cells(1, 11), order1:=xlAscending, Header:=xlNo
         On Error Resume Next
        Intersect(.Columns(11).SpecialCells(xlCellTypeConstants, 16).EntireRow, .Rows).Clear
        .Columns(11).EntireColumn.Delete
    End With
End With
End Sub

Sur la 2ème feuille il n'y aura pas de problème s'il n'y a pas de #N/A en ligne 2.

A+

Grand merci !!
ça marche.