Bonjour à tous,
Liste déroulante en "H1" pour choix du tri,
numérotation des colonnes "B" et "D" à vérifier (non affectées par les tris)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%, cL%, x%, P%
'Macro par Claude Dubois pour "BRENNUS" Excel-Pratique le 4 mai 2011
If Not Application.Intersect(Target, Range("h1")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
'--- choix tri (cL = N° col)---
Select Case Target
Case Is = "1er Tri": GoTo Tri1
Case Is = "2ème Tri": cL = 20
Case Is = "3ème Tri": cL = 22
Case Else: GoTo Fin
End Select
'--- tri ---
If cL = 20 Then 'colonne "S" décroissant
Range("d6:z25").Sort Key1:=Cells(6, cL - 1), Order1:=xlDescending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False
Else 'colonne "U" croissant
Range("d6:z25").Sort Key1:=Cells(6, cL - 1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False
End If
'--- couleurs ---
For i = 6 To 25
Cells(i, cL) = i - 5 'N° à écrire
Select Case i - 5 '
Case Is = 1: x = 6: P = 1 'jaune
Case Is = 2: x = 5: P = 2 'bleu
Case Is = 3: x = 34: P = 1 'turquoise
Case Is = 4, 5, 6: x = 39: P = 1 'lavande
Case Is = 17: x = 45: P = 1 'orange
Case Is = 18, 19, 20: x = 3: P = 2 'rouge
Case Else: x = 1: P = 2 'noir
End Select '
Cells(i, cL).Interior.ColorIndex = x 'couleur fond
Cells(i, cL).Font.ColorIndex = P 'couleur police
Next i
GoTo Fin
'---
Tri1:
Range("d6:z25").Sort _
Key1:=Range("h6"), Order1:=xlDescending, _
Key2:=Range("w6"), Order2:=xlDescending, _
Key3:=Range("s6"), Order2:=xlDescending, _
Header:=xlNo, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Fin:
Application.Goto Range("a1"), Scroll:=True
Target.Activate
End If
End Sub
Amicalement
Claude