Je vous propose une procédure de tri basée sur l’ancienne méthode Sort de l’objet Range afin de garder une portabilité avec la version 2003. Elle est donc limitée à 3 niveaux de tri.
Cette procédure nommée SortTable (version 5,1) à six arguments dont un seul est obligatoire.

Les arguments

Ils sont au nombre de six et un seul est obligatoire.
SheetOrRange de type (Object) pouvant être une feuille ou un Range.
Si l’objet est de type worksheet, on considère que la table commence à la cellule A1 de cette feuille
[SortList] – (String) liste des n° de colonnes à trier séparés par un point virgule
Le n° de colonne correspond au n° de colonne dans la table
Si le n° est négatif le tri est descendant. Exemple SortList:= »2;4;-6″
Si le n° contient une décimale et que la ligne ou la colonne à trier contient du texte convertible en nombres (exemple 13.2 4.2 ou ‘100 / ‘70050), le tri se fera comme un numérique (option xlSortTextAsNumbers de l’argument DataOptionX de la méthode Sort)
[Header] – (Boolean) Défini si la table à une en-tête. (xlYes pas défaut).
[Extend] – (Boolean). Indique si la référence à la table doit être étendue (Cas de colonne unique contigüe). True par défaut
[Orientation] – (Byte) Tri par colonne [default] (xlSortColumns/xlTopToBottom/1) ou par ligne (xlSortRows/xlLeftToRight/2)
[CustomList] – (String). Permet de faire un tri personnalisé sur la première clé. La liste doit être séparée par des points virgules. Exemple : « La plus grande distinction;Grande distinction;Distinction;Satisfaction »

Le code

Public Sub SortTable(SheetOrRange As Object, Optional SortList As String = "1", _
                     Optional Header As Boolean = True, Optional Extend As Boolean = True, _
                     Optional Orientation As Byte = xlSortColumns, Optional CustomList As String)
 ' Procédure de Tri - fonctionne avec les versions 2003-2010
 ' Author  : Philippe Tulliez
 ' Date    : 2013-06-21 (Version 1 du 2012-04-01)
 ' Version : 5.1
 ' Arguments
 '  SheetOrRange  - Objet pouvant être une feuille ou un Range.
 '                  Si l'objet est Worksheet, on considère que la table commence à la cellule "A1" de cette feuille
 '  [SortList]    - String Liste des n° de colonnes à trier séparé par un point virgule
 '                  Le n° de colonne correspond au n° de colonne dans la table
 '                  Si le n° est négatif le tri est descendant. Exemple SortList:="2;4;-6"
 '                  Si le n° contient une décimale et que la ligne ou la colonne à trier
 '                    contient du texte convertible en nombres (exemple 13.2 4.2 ou '100 / '70050)
 '                    le tri se fera comme un numérique (option de l'argument DataOptionX de la méthode Sort)
 '  [Header]      - Défini si la table à une en-tête. (xlYes pas défaut).
 '  [Extend]      - Boolean. Indique si la référence à la table doit être étendue (Cas de colonne unique contigüe). True par défaut
 '  [Orientation] - Tri par colonne [default] (xlSortColumns/xlTopToBottom/1) ou par ligne (xlSortRows/xlLeftToRight/2)
 '  [CustomList]  - de type String, permet de faire un tri personnalisé sur la première clé
 '                  La liste doit être séparée par des points virgules. Exemple : "Très bon;Bon;Moyen;Pas bon"
 Const ErrTitle As String = "Procédure - SortTable"
 Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf
 Dim Table As Range, tblSortList() As String, sTbl_1 As String, c As Long
 Dim SortOrder(1 To 3) As Byte, SortAddr(1 To 3) As String, SortTxtVal(1 To 3) As Byte
 Dim Row As Long, Col As Integer
 On Error GoTo ErrorHandle
 Select Case True ' Test 1er argument
  Case TypeOf SheetOrRange Is Worksheet: Set Table = SheetOrRange.Range("A1")
  Case TypeOf SheetOrRange Is Range: Set Table = SheetOrRange
  Case Else: Error 10001 ' Goto Gestionnaire d'erreur
 End Select
 Select Case Extend
  Case True: Set Table = Table.CurrentRegion
  Case False
   With Table.Worksheet: Set Table = .Range(.Cells(Table.Row, Table.Column), .Cells(Table.End(xlDown).Row, Table.Column)):  End With
 End Select
 If Orientation = xlSortRows And Header = True Then
  With Table: Set Table = .Offset(, 1).Resize(, .Columns.Count - 1):  End With
 End If
 If Table.Cells.Count = 1 Then Error 10002 ' Goto Gestionnaire d'erreur
 tblSortList = Split(SortList, ";")
 ' Affectation des valeurs à SortOrder, SortAddr, SortTxtVal
 For c = 0 To 2
  If (c > UBound(tblSortList)) Then sTbl_1 = Val(tblSortList(UBound(tblSortList))) Else sTbl_1 = Val(tblSortList(c))
  SortTxtVal(c + 1) = xlSortNormal + Abs((sTbl_1 <> Int(sTbl_1))): sTbl_1 = Int(sTbl_1) ' xlSortNormal/xlSortTextAsNumbers
  With Table
   ' Ctrl si n°ligne/colonne à trier pas > Ligne/Colonne de Table + Calcul SortAddr & SortOrder
   Select Case Orientation
     Case xlSortColumns: If Abs(sTbl_1) + .Column - 1 >= .Column + .Columns.Count Then Error 10003
       Row = .Row + Abs(Header = True): Col = .Column + Abs(sTbl_1) - 1
     Case xlSortRows: If Abs(sTbl_1) + .Row - 1 >= .Row + .Rows.Count Then Error 10003
       Row = .Row + Abs(sTbl_1) - 1: Col = .Column
   End Select
   SortOrder(c + 1) = xlAscending + Abs(Val(sTbl_1) < 0): SortAddr(c + 1) = Cells(Row, Col).Address
  End With
 Next c
 ' *** Sort ***
 If Len(CustomList) Then Application.AddCustomList ListArray:=Split(CustomList, ";") ' Tri sur liste personnalisée
 With Table
  .Sort _
   Key1:=.Worksheet.Range(SortAddr(1)), Order1:=SortOrder(1), DataOption1:=SortTxtVal(1), _
   Key2:=.Worksheet.Range(SortAddr(2)), Order2:=SortOrder(2), DataOption2:=SortTxtVal(2), _
   Key3:=.Worksheet.Range(SortAddr(3)), Order2:=SortOrder(3), DataOption3:=SortTxtVal(3), _
    Header:=xlNo + Header, Orientation:=Orientation, MatchCase:=False, _
    OrderCustom:=1 + (Application.CustomListCount * Abs(Len(CustomList) > 0))
 End With
 If Len(CustomList) Then With Application: .DeleteCustomList .CustomListCount: End With ' Destruction de la liste personnalisée
 On Error GoTo 0: Set Table = Nothing: Exit Sub ' *** Fin de procédure ***
 ' Gestionnaire des erreurs de la procédure
ErrorHandle:
 Select Case Err
  Case 10001: Err.Description = "Variable Objet (SheetOrRange) mal définie (WorkSheet) ou (Range)"
  Case 10002 ' Pas de plage à trier (Une seule Cellule)
    With Table
     Err.Description = "Argument : SheetOrRange, référence passée= " & .Worksheet.Name & "!" & .Address & vbCrLf & "Pas de plage à trier"
    End With
  Case 10003 ' Dépassement de capacité (ligne ou colonne à trier hors de la table
   With Err
   .Description = "Problème d'argument [SortList] = " & SortList
   .Description = .Description & vbCrLf & "Impossible de trier la " & IIf(Orientation = xlSortColumns, "colonne ", "ligne ") & Abs(tblSortList(c))
   .Description = .Description & vbCrLf & "La plage " & Table.Address & " de la feuille [" & Table.Worksheet.Name & "]"
   .Description = .Description & ", ne contient que " & IIf(Orientation = xlSortColumns, Table.Columns.Count, Table.Rows.Count)
   .Description = .Description & IIf(Orientation = xlSortColumns, " colonnes.", " lignes.")
   End With
 End Select
 MsgBox ErrMsg & Err.Description, vbCritical, Title:=ErrTitle
 On Error GoTo 0: Set Table = Nothing: Exit Sub
End Sub

Classeur exemple à télécharger