Ordonner des nombres

Sub JJ1()
Dim I%, J%, K%, Tableau(), Total As Long, Comparer As Long
Dim Plage As Range, Résultat As Range, Valeurs As Range
Set Plage = Application.InputBox("Plage à trier ?", "Sélection de la base", , , , , , 8)
Set Résultat = Application.InputBox("1ère cellule de la base triée ?", "Sélection de l'emplacement du tri", , , , , , 8)
Set Résultat = Range(Résultat, Résultat.Offset(Plage.Rows.Count - 1, Plage.Columns.Count - 1))
Set Valeurs = Application.InputBox("Plage des valeurs ?", "Sélection des références", , , , , , 8)
Application.ScreenUpdating = False
ReDim Tableau(Plage.Rows.Count - 1)
For I = 0 To Plage.Rows.Count - 1
For J = 1 To Plage.Columns.Count
For K = 1 To Valeurs.Count
If Plage.Cells(I + 1, J) = Valeurs.Cells(K) Then Total = Total + 2 ^ (Valeurs.Count - K): Exit For
Next K
Next J
Tableau(I) = Total
Total = 0
Next I
For I = 1 To Plage.Rows.Count
Comparer = Application.WorksheetFunction.Large(Tableau, I)
For J = 0 To Plage.Rows.Count - 1
If Comparer = Tableau(J) Then Exit For
Next J
For K = 1 To Plage.Columns.Count
Résultat.Cells(I, K) = Plage.Cells(J + 1, K)
Next K
Next I
Application.ScreenUpdating = True
End Sub

BaseTri.FormulaArray = _
        "=IF(COUNTIF(Valeurs,Base),Base/2^MATCH(Base,Valeurs,0))"

Sub TestTri()
Dim Base As Range, DerLigne&, BaseTri As Range, i&, t!
DerLigne = Range("A" & Rows.Count).End(xlUp).Row
Set Base = [A2].CurrentRegion.Offset(1, 0).Resize(DerLigne - 1)
Set BaseTri = [G2].Resize(Base.Rows.Count, Base.Columns.Count)
Application.ScreenUpdating = False
    BaseTri.FormulaArray = _
        "=IF(COUNTIF(Valeurs,Base),Base/2^MATCH(Base,Valeurs,0))"
    BaseTri.Value = BaseTri.Value
    
        For i = 2 To Base.Rows.Count + 1
            Cells(i, 12) = Application.Sum(Range(Cells(i, 7), Cells(i, 11)))
        Next i
           
    For i = 1 To Base.Rows.Count
        Cells(i + 1, 13) = Application.Match(Application.Large(Range(Cells(2, 12), Cells(Base.Rows.Count + 1, 12)), i), Range(Cells(2, 12), Cells(Base.Rows.Count + 1, 12)), 0)
    Next i
    
    BaseTri.Resize(BaseTri.Rows.Count, BaseTri.Columns.Count + 1).ClearContents
    
    For i = 2 To Base.Rows.Count + 1
      Range(Cells((Cells(i, 13).Value) + 1, 1), Cells((Cells(i, 13).Value) + 1, Base.Columns.Count)).Copy Destination:= _
      Range(Cells(i, 7), Cells(i, 11))
    Next i
    Application.ScreenUpdating = True
   End Sub

Sub TestTriTableau()
Dim Base, Valeurs, DerLigne&, DerCol%, i&, j%, Resultat, temp
DerLigne = Range("A" & Rows.Count).End(xlUp).Row
DerCol = [A2].CurrentRegion.Columns.Count
Base = [A2].CurrentRegion.Offset(1, 0).Resize(DerLigne - 1)
Valeurs = Range("N1", [N1].End(xlToRight)).Value
Application.ScreenUpdating = False
Dim BaseTri()
ReDim BaseTri(1 To DerLigne - 1)
For i = 2 To DerLigne
    For j = 1 To DerCol
            Resultat = Base(i - 1, j)
            Resultat = Resultat / 2 ^ Application.Match(Resultat, Valeurs, 0)
            Base(i - 1, j) = Resultat
            temp = temp + Resultat
    Next j
    BaseTri(i - 1) = temp
    temp = 0
    Resultat = 0
Next i
Dim Tableau()
ReDim Tableau(1 To DerLigne - 1)
For i = 1 To DerLigne - 1
    Tableau(i) = Application.Match(Application.Large(BaseTri, i), BaseTri, 0)
Next i

For i = 1 To DerLigne - 1
    For j = 1 To DerCol
        Cells(i + 1, j + DerCol + 1) = Cells(Tableau(i) + 1, j)
    Next j
Next i
Application.ScreenUpdating = True
End Sub