Inventaire - trier une liste de cotes "Lettre/chiffres/chiffre"

Option Base 1
Sub classe()
'definir la 1ere ligne a partir de laquelle on effectue le tri
lig_deb = 2
Dim tabres
For n = lig_deb To Range("A" & Rows.Count).End(xlUp).Row
 If InStr(Range("A" & n), ";") <> 0 Then
    x = Split(Range("A" & n), ";")
    For m = LBound(x) To UBound(x)
      For p = LBound(x) To UBound(x)
        If Trim(x(m)) < Trim(x(p)) Then
          temp = x(m)
          x(m) = x(p)
          x(p) = temp
        End If
      Next p
    Next m
  For Z = LBound(x) To UBound(x)
    zz = zz & Trim(x(Z)) & " ; "
  Next Z
  Range("A" & n) = Left(zz, Len(zz) - 3)
  zz = ""
 End If
Next n

tablo = Range("A" & lig_deb & ":A" & Range("A" & Rows.Count).End(xlUp).Row)
ReDim tabres(UBound(tablo, 1), 3)
For n = 1 To 3
  Columns(2).Insert
Next
For n = LBound(tablo, 1) To UBound(tablo, 1)
 x = Split(tablo(n, 1), "/")
  For m = LBound(x) To UBound(x)
    If m < 3 Then tabres(n, m + 1) = Trim(x(m))
  Next m
Next n
Range("B" & lig_deb).Resize(UBound(tabres, 1), 3) = tabres

ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B" & lig_deb & ":B" & Range("B" & Rows.Count).End(xlUp).Row) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("C" & lig_deb & ":C" & Range("B" & Rows.Count).End(xlUp).Row) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("D" & lig_deb & ":D" & Range("B" & Rows.Count).End(xlUp).Row) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
    ' adapter la derniere colonne du tri (ici colonne S
        .SetRange Range("A" & lig_deb & ":S" & Range("B" & Rows.Count).End(xlUp).Row)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Columns("B:D").Delete
End Sub