Microsoft 365 Suppression lignes par rapport à une date

[pierrof]

Bonjour à tous,

Dans un nouveau projet j'aimerais mettre en forme un tableau en supprimant des lignes par rapport à une date.

En effet j'aimerais supprimer toutes les lignes du tableau si la date dans la colonne L est inférieur ou égale à la date de la cellule U2.

Je laisse un petit fichier exemple.

Merci de votre aide

Bonne journée

 

[djidji59430]

Bonjour à tous,

Et après, tu n'as plus besoin du tableau original ?

Crdlmt

 

[pierrof]

Bonjour à tous,

Et après, tu n'as plus besoin du tableau original ?

Crdlmt

Bonjour,

Non, plus besoin.

Cordialement

 

[djidji59430]

Bonjour à tous,

je sais faire avec une formule (ça s'appelle un filtre), mais on garde l'original ! en VBA, je ne sais pas.

 

[sylvanu]

Bonjour Pierrof, Djidji,
Un essai en PJ.
Il suffit de modifier la date de suppression pour que le filtre s'effectue automatiquement en feuille Filtrée.
Avec :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [U2]) Is Nothing Then
         Application.ScreenUpdating = False
         Dim DL%, L%
         DL = Cells(Cells.Rows.Count, "L").End(xlUp).Row
         With Sheets("Filtrée")
            .Cells.Clear
            .Range("A1:L" & DL) = Range("A1:L" & DL).Value
            For L = DL To 2 Step -1
                If .Cells(L, "L") <= Target Then .Cells(L, "A").EntireRow.Delete
            Next L
            .Select
         End With
    End If
Fin:
End Sub

 

[pierrof]

Bonjour Pierrof, Djidji,
Un essai en PJ.
Il suffit de modifier la date de suppression pour que le filtre s'effectue automatiquement en feuille Filtrée.
Avec :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [U2]) Is Nothing Then
         Application.ScreenUpdating = False
         Dim DL%, L%
         DL = Cells(Cells.Rows.Count, "L").End(xlUp).Row
         With Sheets("Filtrée")
            .Cells.Clear
            .Range("A1:L" & DL) = Range("A1:L" & DL).Value
            For L = DL To 2 Step -1
                If .Cells(L, "L") <= Target Then .Cells(L, "A").EntireRow.Delete
            Next L
            .Select
         End With
    End If
Fin:
End Sub

Bonjour Sylvanu,
Merci ça fonctionne, mais si je ne veux pas garder l'original mais que les lignes se suppriment de suite à l'aide d'un bouton ,ets-ce que le code peut adapté?
Car ensuite j'ai une autre mise en forme à réaliser en supprimant des lignes dont certaines cellules ne sont pas listé dans un autre tableau...

Merci

 

[sylvanu]

Re,

mais si je ne veux pas garder l'original mais que les lignes se suppriment de suite à l'aide d'un bouton ,ets-ce que le code peut adapté?

Voir PJ avec :

Sub SupprimerLignes()
    Application.ScreenUpdating = False
    Dim DL%, L%, DateSupp
    DL = Cells(Cells.Rows.Count, "L").End(xlUp).Row
    DateSupp = [T1]
    For L = DL To 2 Step -1
        If Cells(L, "L") <= DateSupp Then Cells(L, "A").EntireRow.Delete
    Next L
End Sub

A noter que bouton et Date à supprimer doivent se trouver en ligne 1 car la ligne 2 pourrit être supprimée suivant la date en colonne L.

 

[Phil69970]

Bonjour à tous

A la bourre car j'avais une course urgente à faire
Une solution parmi plein d'autres Je l'ai fait je le poste

Merci de ton retour

 

[pierrof]

Re,

Voir PJ avec :

Sub SupprimerLignes()
    Application.ScreenUpdating = False
    Dim DL%, L%, DateSupp
    DL = Cells(Cells.Rows.Count, "L").End(xlUp).Row
    DateSupp = [T1]
    For L = DL To 2 Step -1
        If Cells(L, "L") <= DateSupp Then Cells(L, "A").EntireRow.Delete
    Next L
End Sub

A noter que bouton et Date à supprimer doivent se trouver en ligne 1 car la ligne 2 pourrit être supprimée suivant la date en colonne L.

Super, merci beaucoup ça fonctionne et oui pour la date j'ai pensé après avoir déposé le fichier 🙂.

Pour finaliser mon projet, il faudrait que puisse supprimer les lignes du tableau dont les cellu de la colonne D ne correpondent pas aux valeur de la colonne A de la feuille List_Org.

est-ce que tu crois que c'est possible d'avoir un code VBA pour que le tableau se mettent à jour ?

Merci

Bon app

 

[sylvanu]

Re,
Si j'ai bien compris, essayez cette PJ avec :

Sub Supp_Lignes()
 Application.ScreenUpdating = False
    Dim DL%, DL1%, L%, DateSupp
    DL1 = Sheets("Liste_Org").Cells(Cells.Rows.Count, "A").End(xlUp).Row
    Set Plage = Sheets("Liste_Org").Range("A2:A" & DL1)
    DL = Cells(Cells.Rows.Count, "L").End(xlUp).Row
    DateSupp = [T1]
    For L = DL To 2 Step -1
        If Cells(L, "L") <= DateSupp Or Application.CountIf(Plage, Cells(L, "D")) = 0 Then Cells(L, "A").EntireRow.Delete
    Next L
End Sub

 

[pierrof]

Re,
Si j'ai bien compris, essayez cette PJ avec :

Sub Supp_Lignes()
 Application.ScreenUpdating = False
    Dim DL%, DL1%, L%, DateSupp
    DL1 = Sheets("Liste_Org").Cells(Cells.Rows.Count, "A").End(xlUp).Row
    Set Plage = Sheets("Liste_Org").Range("A2:A" & DL1)
    DL = Cells(Cells.Rows.Count, "L").End(xlUp).Row
    DateSupp = [T1]
    For L = DL To 2 Step -1
        If Cells(L, "L") <= DateSupp Or Application.CountIf(Plage, Cells(L, "D")) = 0 Then Cells(L, "A").EntireRow.Delete
    Next L
End Sub

C'est parfait encore une fois.
Merci beaucoup Sylvanu bonne journée

 

[Phil69970]

@pierrof

Non seulement j'ai posté à la bourre mais en plus je suis invisible !!
C'est pas mon jour de chance !!!

 

[pierrof]

@pierrof

Non seulement j'ai posté à la bourre mais en plus je suis invisible !!
C'est pas mon jour de chance !!!

Oups, Bonjour Phili69970,
Désolé je n'avais pas vu...
Merci de ta réponse également !!!

Bonne journée

 

[Phil69970]

@pierrof

Mais l'as tu regardé au moins ?

 

[pierrof]

@pierrof

Mais l'as tu regardé au moins ?

Oui je l'ai essayé, mais je n'arrive pas à l'adapter sur mon projet.
Merci quand même.
Bonne journée