XL 2019 Supprimer lignes après échéance

KTM

XLDnaute Impliqué
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
 

Pièces jointes

  • Classe.xlsm
    23.3 KB · Affichages: 7

job75

XLDnaute Barbatruc
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

XLDnaute Impliqué
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.
 

Statistiques des forums

Discussions
299 792
Messages
1 979 138
Membres
206 583
dernier inscrit
julien6363