Modif Macro

Bonjour

J'ai besoin d'une "petite" modif sur une Macro voir fichier joint

Merci d'avance

Nonno

Bonjour

Peut être avec une macro de ce type que vous appelez à la fin de la macro archive

• Avant le END SUB de la macro archives mettez ceci --> Call TRIER
• En dessous de la macro archiver, mettez ce code

Sub Trier()

With Worksheets("Archives").ListObjects("Tableau7").Sort
    .SortFields.Clear
    .SortFields.Add2 Key:=Range("Tableau7[N°Cde]"), SortOn:=xlSortOnValues, Order:=xlDescending
    .SortFields.Add2 Key:=Range("Tableau7[Date]"), SortOn:=xlSortOnValues, Order:=xlAscending
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
End Sub

Si ok, oubliez pas de cloturer le fil en cliquant sur le petit v en haut à droite du post de votre réponse

Cordialement

Bonjour,

Bonjour Dan,

Une autre proposition (à l'identique !?).

Cdlt.

Public Sub archiver()
Dim ws As Worksheet
Dim plage As Range, lo As ListObject, r As Range
Dim NumCde As Long, DateCde As Date, DerLig As Long

    Set ws = Worksheets("Bon")
    Set lo = Range("T_Archives").ListObject
    If Not IsEmpty(ws.Range("C22")) Then
        With ws
            NumCde = .Range("C6").Value
            DateCde = .Range("H6").Value
            DerLig = .Cells(.Rows.Count, "C").End(xlUp).Row
            Set plage = .Range("C22:H" & DerLig)
        End With
        With lo
            If .InsertRowRange Is Nothing Then
                Set r = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
            Else
                Set r = .InsertRowRange.Cells(1)
            End If
        End With
        r.Offset(, 2).Resize(plage.Rows.Count, 6).Value = plage.Value
        r.Resize(plage.Rows.Count).Value = NumCde
        r.Offset(, 1).Resize(plage.Rows.Count).Value = DateCde
        With lo
            .Sort.SortFields.Add Key:=.ListColumns(1).DataBodyRange, Order:=xlDescending
            .Sort.Header = xlYes
            .Sort.Apply
            .Sort.SortFields.Clear
        End With
        ws.Range("C6").Value = ws.Range("C6")
    End If
End Sub

Merci Jean Eric, merci Dan

La proposition de Dan Fonctionne un petit Bogue avec celle de Jean Eric .

J'ai remis le fichier avec les 2 macros .

Merci encore

Crdlmt

Nonno

Re,

Après la copie de la procédure, il suffisait de remplacer T_Archives par Tableau7 !...

Cdlt.

[quote=Jean-Eric post_id=877886 time=1591634708 user_id=18632]

Re,

Après la copie de la procédure, il suffisait de remplacer T_Archives par Tableau7 !...

Cdlt.

Merci maintenant j'ai 2 solutions :

Cdlt