XL 2019 Supprimer lignes après échéance

KTM · 24 Mars 2022

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.

VB:

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 · 24 Mars 2022

Bonjour KTM,

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

VB:

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 · 24 Mars 2022

job75 à dit:

Bonjour KTM,

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

VB:

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.

XL 2019 Supprimer lignes après échéance

KTM

XLDnaute Impliqué

Pièces jointes

job75

XLDnaute Barbatruc

KTM

XLDnaute Impliqué

Discussions similaires