Comment trier plusieurs plages ?

Bonjour, je reviens vous demander votre aide....

Dans le classeur joint dans le code de la feuille 2 j'ai écrit ça (enfin... l'enregistreur de macros..):

Private Sub Worksheet_Activate()

    Range("B3:D100").Select
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add _
        Key:=Range("B3:B100"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add _
        Key:=Range("D3:D100"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
        .SetRange Range("B3:D100")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("N3").Select

End Sub

Cela me permet pour la semaine 1 "S01" de trier (jusqu'à la ligne 100) les données par code "CODE" et ensuite par quantité "QTE" à l'activation de la feuille.

J'essaie depuis un moment aujourd'hui de créer une boucle qui traiterait ainsi les 51 semaine restantes, mais je n'y arrive pas.

Ma boucle redéfinirait les "Range", enfin, c'est mon idée, mais je n'arrive pas à saisir la syntaxe...

J'ai aussi essayé de définir plusieurs plages, et de trier les plages, mais sans succès..

Show me the way pleeeease

PS: j'aurai ensuite le souci de supprimer les doublons dans chaque liste triée, mais en additionnant les quantités...

Ceci est une autre histoire...

Salut,

Normalement le code ci-dessous devrait faire l'affaire.

Private Sub Worksheet_Activate()
Dim i As Integer

Application.ScreenUpdating = False

For i = 2 To 206 Step 4
    Range(Cells(2, i), Cells(Rows.Count, i + 2)).Sort Key1:=Cells(2, i), Order1:=xlAscending, Key2:=Cells(2, i + 2), Order1:=xlAscending, Header:=xlYes
Next i

End Sub

BastLat a écrit :

PS: j'aurai ensuite le souci de supprimer les doublons dans chaque liste triée, mais en additionnant les quantités...

Ceci est une autre histoire...

Tu peux donner un exemple ?

Cordialement.

Yvouille a écrit :

Salut,

Normalement le code ci-dessous devrait faire l'affaire.

Impeccable ! Merci ! Pourquoi faire simple quand on peut faire compliqué.... J'ai encore beaucoup à apprendre

Yvouille a écrit :

BastLat a écrit :

PS: j'aurai ensuite le souci de supprimer les doublons dans chaque liste triée, mais en additionnant les quantités...

Ceci est une autre histoire...

Tu peux donner un exemple ?

Cordialement.

Oui volontiers !!

La suite ça serait par exemple, de passer de ça:

A006 ia6 220

A007 ia7 5

A008 ia8 1

A008 ia8 1

A015 ia15 5

A023 ia23 200

A023 ia23 200

A024 ia24 10

à ça:

A006 ia6 220

A007 ia7 5

A008 ia8 2

A015 ia15 5

A023 ia23 400

A024 ia24 10

Supprimer les doublons de chaque liste, mais additionner les quantités lorsqu'un code est revenu plusieurs fois.

BastLat a écrit :

Supprimer les doublons de chaque liste, mais additionner les quantités lorsqu'un code est revenu plusieurs fois.

Je m'auto quote car j'y suis arrivé tout seul !

C'est peut être pas très élégant, mais ça marche...

Private Sub Worksheet_Activate()
Dim Col As Integer
Dim Lig As Integer
Dim Vide As Integer
Dim NbLg As Integer
Dim NbLg1 As Integer
Application.ScreenUpdating = False
For Col = 2 To 206 Step 4
retri:
    Range(Cells(2, Col), Cells(Rows.Count, Col + 2)).Sort Key1:=Cells(2, Col), Order1:=xlAscending, Key2:=Cells(2, Col + 2), Order1:=xlAscending, Header:=xlYes
    NbLg = Cells(Rows.Count, Col).End(xlUp).Row
    For Lig = 3 To NbLg
        If Cells(Lig, Col).Value = Cells(Lig + 1, Col).Value Then
            Cells(Lig + 1, Col).Value = ""
            Cells(Lig + 1, Col + 1).Value = ""
            Cells(Lig, Col + 2).Value = Cells(Lig, Col + 2).Value + Cells(Lig + 1, Col + 2).Value
            Cells(Lig + 1, Col + 2).Value = ""
        End If
    Next
    NbLg1 = Cells(Rows.Count, Col).End(xlUp).Row
    Cells(NbLg1 + 1, Col + 2).Value = ""
    For Vide = 3 To NbLg1
        If Cells(Vide, Col).Value = "" Then GoTo retri
    Next
Next
End Sub

Il me reste une dernière chose à faire, c'est de retrier encore les colonnes de telle sorte que les catégories de codes A, B, C soient classées par ordre décroissant de quantité.

Exemple:

A015 ia15 10

A023 ia23 350

A029 ia29 81

B015 ib15 23

C014 ic14 25

C020 ic20 53

deviendrait:

A023 ia23 350

A029 ia29 81

A015 ia15 10

B015 ib15 23

C020 ic20 53

C014 ic14 25

Ça revient à faire un tri en fonction de la première lettre de la case "CODE", et non de son contenu entier.

Possible ?

BastLat a écrit :

Ça revient à faire un tri en fonction de la première lettre de la case "CODE", et non de son contenu entier.

Possible ?

Deuxième et dernier "auto quote" car je viens de résoudre mon problème.

De cette manière:

Private Sub Worksheet_Activate()

Dim Col As Integer
Dim Lig As Integer

Application.ScreenUpdating = False

If Cells(1, 1).Value = "T" Then Exit Sub
'_______________________________________________________TRI DES CODES
For Col = 2 To 206 Step 4
    NbLg = Cells(Rows.Count, Col).End(xlUp).Row
    If NbLg = 2 Then GoTo suivant
    For Lig = 3 To NbLg
        Cells(Lig, Col - 1).Value = Left((Cells(Lig, Col).Value), 1)
    Next
    Range(Cells(2, Col - 1), Cells(Rows.Count, Col + 2)).Sort Key1:=Cells(2, Col - 1), Order1:=xlAscending, Key2:=Cells(2, Col + 2), Order2:=xlDescending, Header:=xlYes
    For Lig = 3 To NbLg
        Cells(Lig, Col - 1).Value = ""
    Next
suivant:
Next
'_______________________________________________________SEPARATION DES FAMILLES
For Col = 2 To 206 Step 4
    NbLg = Cells(Rows.Count, Col).End(xlUp).Row
    For Lig = NbLg To 3 Step -1
        If Left((Cells(Lig, Col).Value), 1) <> Left((Cells(Lig - 1, Col).Value), 1) Then
                Range(Cells(Lig, Col), Cells(Lig, Col + 2)).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Selection.Interior.ColorIndex = 37
        End If
    Next
Next

'Cells(1, 1).Value = "T"
Cells(1, 1).Select

End Sub

Merci Yvouille