Algo de tri en VBA -> affecter une place en fonction du score

Sub test()
Dim Tblo As Variant, Rg As Range

With Worksheets("Feuil1")
    Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
Tblo = Application.Transpose(Rg)
Quick_Sort Tblo, LBound(Tblo), UBound(Tblo)
Rg.Offset(, 1).Resize(UBound(Tblo)) = Application.Transpose(Tblo)
Set Rg = Nothing

End Sub
'-----------------------------------------------

Sub Quick_Sort(ByRef SortArray As Variant, ByVal First As Long, ByVal Last As Long)
Dim Low As Long, High As Long
Dim Temp As Variant, List_Separator As Variant
Low = First
High = Last
List_Separator = SortArray((First + Last) / 2)
Do
    Do While (SortArray(Low) < List_Separator)
        Low = Low + 1
    Loop
    Do While (SortArray(High) > List_Separator)
        High = High - 1
    Loop
    If (Low <= High) Then
        Temp = SortArray(Low)
        SortArray(Low) = SortArray(High)
        SortArray(High) = Temp
        Low = Low + 1
        High = High - 1
    End If
Loop While (Low <= High)
If (First < High) Then Quick_Sort SortArray, First, High
If (Low < Last) Then Quick_Sort SortArray, Low, Last
End Sub