Bonjour Joe et Zon,
Voici en pièce jointe une petite variante sur le même thème ...
=====================================================
Private Sub CommandButton1_Click()
'Désactivation Affichage pendant déroulement Macro (Optimisation)
Application.ScreenUpdating = False
'Si la feuille "Save" existe, alors copie feuille "Save" dans feuille "Résultats", sinon rien
For Each Sht In Sheets
If Sht.Name = "Save" Then
Sht.Cells.Copy Destination:=Sheets("Résultats").Range("A1")
Exit For
End If
Next Sht
'Ajout d'un colonne 1 contenant les n° de ligne avant tri pour appareillage
Sheets("Résultats").Activate
ActiveSheet.Columns(1).Insert Shift:=xlToRight
Set RngTit = ActiveWorkbook.Names("Titre").RefersToRange
Set RngTbl = ActiveWorkbook.Names("Tableau").RefersToRange
Set RngWrk = ActiveSheet.Range("A1:" & RngTbl.Cells(RngTbl.Cells.Count).Address)
For Each Row In RngWrk.Rows
Row.Cells(1) = Row.Row
Next Row
'Tri sur les colonnes Jockey et Entraîneur pour détection des doubles
RngWrk.Sort Key1:=RngWrk.Columns("E").Rows(1), Order1:=xlAscending, Key2:=RngWrk.Columns("F").Rows(1), _
Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
'Appareillage des lignes et coloriage des doublons sur Jockey et Entraineur
For Each Cel In RngWrk.Columns("E").Cells
If Cel <> "" And Cel.EntireRow.Cells(1) <> RngTit.Row Then
Sheets("Résultats").Range(Cel.Address & ":" & Cel.Offset(0, 1).Address).Interior.ColorIndex = _
ActiveWorkbook.Names("ColNo").RefersToRange.Interior.ColorIndex
If Cel.Row > 1 Then
If Cel = Cel.Offset(-1, 0) And Cel.Offset(0, 1) = Cel.Offset(-1, 1) Then _
Sheets("Résultats").Range(Cel.Offset(-1, 0).Address & ":" & Cel.Offset(0, 1).Address).Interior.ColorIndex = _
ActiveWorkbook.Names("ColYes").RefersToRange.Interior.ColorIndex
End If
End If
Next Cel
'Tri des lignes sur n° de ligne avant tri pour appareillage afin de rétablir l'ordre de départ
RngWrk.Sort Key1:=RngWrk.Columns("A").Rows(1), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Suppression de la colonne n° de ligne avant tri pour appareillage
ActiveSheet.Columns(1).Delete Shift:=xlToLeft
'Réactivation Affichage
Application.ScreenUpdating = True
End Sub
=====================================================
Je pense que les manipulations sont suffisamment simple pour pouvoir se passer de plus d'explications que celles qui figurent dans le code.
En espérant avoir bien compris le problème ....
Cordialement.
Omicron.