Besoin d'aide tri Macro VBA

[Yul80520]

Bonjour,

je souhaite savoir comment améliorer mon fichier excel qui me sert à faire un classement automatique pour mon club de poker.

Je suis presque arrivé à mon but même si je sais que ma macro peut être énormément simplifiée ( Je suis autodidacte et je ne suis pas expert en VBA, loin de là )

Je rencontre un problème au niveau du tri des joueurs. En cas d'égalité au niveau du score final ( qui dépend de la place obtenu à chaque tournoi de la saison et des points de bonus )

Je souhaite ajouter un niveau de tri en cas d'égalité de deux joueurs. Le joueur ayant obtenu les meilleurs classement au cours de la saison devant être mieux récompensé.

Voici la macro à son dernier stade d'évolution:

Sub classement()

'nettoyage de la feuille classement

Rows("2:148").Select
Selection.Delete Shift:=xlUp

'copier les noms dans la feuille de classement final

Sheets("TOTAL FINAL").Range("B2:B96").Copy
Sheets("Classement").Range("B2").PasteSpecial Paste:=xlPasteValues

'copier les colonnes de classement de chaque journée de classement final

Sheets("S2A1").Range("E8:E96").Copy
Sheets("Classement").Range("F2").PasteSpecial Paste:=xlPasteValues

Sheets("S2A2").Range("E8:E96").Copy
Sheets("Classement").Range("G2").PasteSpecial Paste:=xlPasteValues

Sheets("S2A3").Range("E8:E96").Copy
Sheets("Classement").Range("H2").PasteSpecial Paste:=xlPasteValues

Sheets("S2A4").Range("E8:E96").Copy
Sheets("Classement").Range("I2").PasteSpecial Paste:=xlPasteValues

Sheets("S2A5").Range("E8:E96").Copy
Sheets("Classement").Range("J2").PasteSpecial Paste:=xlPasteValues

Sheets("S2A6").Range("E8:E96").Copy
Sheets("Classement").Range("K2").PasteSpecial Paste:=xlPasteValues

Sheets("S2A7").Range("E8:E96").Copy
Sheets("Classement").Range("L2").PasteSpecial Paste:=xlPasteValues

Sheets("S2A8").Range("E8:E96").Copy
Sheets("Classement").Range("M2").PasteSpecial Paste:=xlPasteValues


'copier les résultats dans la feuille de classement final

Sheets("TOTAL FINAL").Range("L2:L96").Copy
Sheets("Classement").Range("C2:C96").PasteSpecial Paste:=xlPasteValues


'copier les points de bonus dans la feuille de classement final

Sheets("TOTAL FINAL").Range("K2:K96").Copy
Sheets("Classement").Range("E2:E96").PasteSpecial Paste:=xlPasteValues

'pour une matrice des lignes 2 à 112
'avec en colonne A un index des joueurs,
'en colonne B leur nom et
'en colonne C le rang que l'on va remplir automatiquement

'classer dans l'ordre alphabétique

Rows("2:96").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


'classer selon le score

Rows("2:96").Select

Selection.Sort Key1:=Range("C2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


' Mettre 1 au rang du premier en donnant comme rang le N° de ligne moins 1

Range("D2").Select
ActiveCell.FormulaR1C1 = "=ROW(RC[-1])-1"

' Au suivant mettre son N° de ligne -1 s'il est différent du précédent,
'sinon mettre comme le précédent

Range("D3").Select
ActiveCell.FormulaR1C1 = "=+IF(RC[-1]=R[-1]C[-1],R[-1]C,ROW(RC[-1])-1)"

'copier cette formule dans toute lma colonne score de la matrice

Range("D3").Select
Selection.AutoFill Destination:=Range("D396"), Type:=xlFillDefault

'Copier la colonne des scores et la coller en valeur (collage spécial valeur)

Range("D296").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'retrier les lignes en fonction de l'index des joueurs

Rows("2:96").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("D3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("D3").Select

Range("D296").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("D296").Select
Selection.ClearContents

' supprimer les lignes entières ne comportant pas de Noms

Range("B2:B96").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

' supprimer La colonne "E"

Columns("D").Delete Shift:=xlToLeft
Range("D11").Select

' mettre en forme le tableau

Range("A1:L46").Select
Range("L1").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With

Columns("D:L").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("L7").Select
Range("D1").Select
ActiveCell.FormulaR1C1 = "Bonus"
Range("D2").Select
Columns("D").ColumnWidth = 10.71
Range("E1").Select
ActiveCell.FormulaR1C1 = "J1"
Range("F1").Select
ActiveCell.FormulaR1C1 = "J2"
Range("E1:F1").Select
Selection.AutoFill Destination:=Range("E1:L1"), Type:=xlFillDefault
Range("E1:L1").Select

' Macro2 Macro
'


Range("A1:L96").Select
Range("L96").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("A1:L1,L3,A3:L3,L5,A5:L5,A7:L7,A9:L9,A11:L11,A13:L13,A15:L15,A17:L17,A19:L19,A21:L21,A23:L23,A25:L25,A27:L27,A29:L29,A31:L31,A33:L33,A35:L35,A37:L37,A39:L39,A41:L41,A43:L43,A45:L45,A47:L47").Select
Range("L5").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With

Range("M1").Select

End Sub



Merci de votre aide, en espérant avoir quelques réponses.