Trier par ordre alphabétique certaine cellule

Sub Tri_disjoint()
Dim tablo, a, b(), i&
tablo = [A1:A100] 'matrice, plus rapide
a = Array(1, 3, 5, 7)
ReDim b(UBound(a)) 'base o
For i = 0 To UBound(b)
    b(i) = tablo(a(i), 1)
Next
tri b, 0, UBound(b)
For i = 0 To UBound(b)
    tablo(a(i), 1) = b(i)
Next
[A1:A100] = tablo 'restitution
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

Sub Tri_disjoint()
Dim tablo, a, b(), i&
tablo = [A1:A100] 'matrice, plus rapide
a = Array(5, 8, 11, 14, 17, 20)
ReDim b(UBound(a)) 'base o
For i = 0 To UBound(b)
    b(i) = tablo(a(i), 1)
    If b(i) = "" Then b(i) = "zzz"
Next
tri b, 0, UBound(b)
For i = 0 To UBound(b)
    If b(i) = "zzz" Then b(i) = ""
    tablo(a(i), 1) = b(i)
Next
[A1:A100] = tablo 'restitution
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

Sub Tri_disjoint()
Dim ZoneTri As Range, coltri%, a, F As Worksheet, aux As Worksheet, P As Range, lig, R As Range, tablo, i&
Set ZoneTri = [A4:G21] 'à adapter, sans en-têtes
coltri = ZoneTri.Column 'à adapter éventuellement
a = Array(5, 8, 11, 14, 17, 20)
Set F = ActiveSheet
Application.ScreenUpdating = False
Set aux = Workbooks.Add.Sheets(1) 'document auxiliaire
Set P = aux.Range(ZoneTri.Address)
P = ZoneTri.Value
For Each lig In a
    If Not Intersect(F.Rows(lig), ZoneTri) Is Nothing Then
        Set R = F.Cells(lig, coltri + 1).MergeArea.EntireRow.Columns(coltri) 'plage fusionnée voisine
        aux.Range(R.Address) = aux.Cells(lig, coltri) 'remplissage de la colonne
    End If
Next lig
coltri = coltri - P.Column + 1
P.Sort P.Columns(coltri), xlAscending, Header:=xlNo 'tri
'---restitution---
tablo = P 'matrice, plus rapide
For i = 1 To UBound(tablo)
    If ZoneTri(i, coltri) = "" Then tablo(i, coltri) = ""
Next
ZoneTri = tablo
aux.Parent.Close False 'ferme le document auxiliaire
End Sub