Compléter une macro par un deuxième tri

[libellule85]

Bonsoir le forum,

Je remercie une nouvelle fois job75 pour la macro suivante : quand on met une date sans astérisque cela classe du plus ancien au plus récent, et quand on ajoute l'astérisque à une date cela classe du plus récent au plus ancien.
J'aimerais rajouter, si cela est possible, un deuxième classement : quand il y a un "x" dans la cellule de droite cela met la ligne en dernier suivant le classement choisi.
Actuellement, il faudrait que toutes les lignes barrées soient mises à la fin du classement (et classées par date) et si le classement est du plus ancien au plus récent il faudrait que les lignes barrées soient au début.
J'espère avoir été clair dans mes explications.
D'avance merci pour votre aide

Private Sub Worksheet_Change(ByVal Target As Range) 'Un grand merci à Job75 pour cette macro
Dim dat$
With ListObjects(1).DataBodyRange
    If Intersect(Target, .Columns(1)) Is Nothing Or Target.Count > 1 Then Exit Sub
    If Target = "" Then
        Rows(Target.Row).Delete
    Else
        If Right(Target, 1) = "*" Then dat = Replace(Target, "*", "")
        If IsDate(dat) Then Target = CDate(dat)
        .Sort .Columns(1), IIf(dat = "", 1, 2), Header:=xlYes
    End If
End With
End Sub

 

[job75]

Bonsoir charmante(e?) libellule85,

Private Sub Worksheet_Change(ByVal Target As Range) 'Un grand merci à Job75 pour cette macro
Dim dat$
With ListObjects(1).DataBodyRange
    If Intersect(Target, .Columns(1)) Is Nothing Or Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    On Error Resume Next
    If Target = "" Then
        Rows(Target.Row).Delete
    Else
        .Columns(7).NumberFormat = "0;;"
        .Columns(7).SpecialCells(xlCellTypeBlanks) = 0
        If Right(Target, 1) = "*" Then dat = Replace(Target, "*", "")
        If IsDate(dat) Then Target = CDate(dat)
        .Sort .Columns(7), IIf(dat = "", 1, 2), .Columns(1), , IIf(dat = "", 1, 2), Header:=xlYes
        .Columns(7).SpecialCells(xlCellTypeConstants, 1) = ""
    End If
    Application.EnableEvents = True
End With
End Sub

Bonne fin de soirée.

 

[libellule85]

Bonsoir Job75,
Tout d'abord merci pour ta réponse. Mais quand je met ta nouvelle macro à la place de l'ancienne et que je veux faire un essai, il ne se passe rien !

 

[job75]

Re,

Et il ne se passe rien non plus quand on ajoute des dates sur votre fichier du post #1.

Le tableau Excel ne s'agrandit pas, le fichier est probablement vérolé.

Avec votre dernier fichier du 30 12 16 ci joint aucun problème.

A+

 

[libellule85]

Re,
Effectivement quand je reprends mon ancien fichier cela fonctionne, une nouvelle fois un grand grand merci pour ton aide...

 

[job75]

Re,

J'avais mal placé les ApplicationEnableEvents, j'ai corrigé mes posts #2 et #4.

Bonne nuit.

 

[libellule85]

Bonjour Job75, le forum,
Merci beaucoup pour le correctif.
Bonne journée