Private Sub Worksheet_Change(ByVal Target As Range)
Dim modele As Range, points As Range, classement As Range, h&, mem, c As Range
Set modele = [Z54:AC54] 'à adapter
Set points = [AA58] 'à adapter
Set classement = [AG58] 'à adapter
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next 'sécurité
points(2).Resize(Rows.Count - points.Row).SpecialCells(xlCellTypeBlanks).Delete xlUp 'supprime les cellules vides
h = Application.Count(points(2).Resize(Rows.Count - points.Row))
'---RAZ---
mem = points(2).Resize(h) 'mémorise
points(2, 0).Resize(Rows.Count - points.Row, 3).Delete xlUp
classement(2, 0).Resize(Rows.Count - classement.Row).Delete xlUp
'---1er tableau---
modele(1).Copy points(2, 0).Resize(h)
points(2, 0) = 1
points(2, 0).Resize(h).DataSeries
modele(2).Copy points(2).Resize(h)
points(2).Resize(h) = mem 'restitution
modele(3).Copy points(2, 2).Resize(h)
points(2, 2).Resize(h) = "=IF(RC[-1]=5,RC[-2],"""")"
points(2, 2).Resize(h) = points(2, 2).Resize(h).Value 'supprime les formules
modele(4).Copy Intersect(points(2).Resize(h), points(2, 2).Resize(h).SpecialCells(xlCellTypeConstants).EntireRow)
'---2ème tableau---
points(2, 0).Resize(h, 2).Sort points, xlDescending, Header:=xlNo 'tri décroissant
points(2, 0).Resize(h).Copy classement(2)
points(2, 0).Resize(h, 2).Sort points(1, 0), xlAscending, Header:=xlNo 'tri croissant
For Each c In points(2, 2).Resize(h).SpecialCells(xlCellTypeConstants)
With classement(2).Resize(h).Find(c, , xlValues, xlWhole)
modele(4).Copy .Cells
.Value = c
End With
Next
Application.EnableEvents = True 'réactive les évènements
End Sub