XL 2010 Tri alphabétique sur plusieurs colonnes

Option Compare Text 'la casse est ignorée

Private Sub TextBox1_Change()
Dim P As Range, tablo(), x$, j%, i&, n&, coul As Range, a$()
Set P = [A1].CurrentRegion.Resize(, 6).Offset(1)
tablo = P 'matrice, plus rapide
Application.ScreenUpdating = False
Intersect(P, [B:B,D:D,F:F]).Interior.ColorIndex = xlNone
ListBox1.Clear
If TextBox1 = "" Then Exit Sub
x = "*" & TextBox1 & "*"
For j = 2 To 6 Step 2
  For i = 1 To P.Rows.Count - 1
    If tablo(i, j) Like x Then
      n = n + 1
      Set coul = Union(IIf(coul Is Nothing, P(i, j), coul), P(i, j))
      If n Mod 50 = 0 Then coul.Interior.ColorIndex = 43: Set coul = Nothing 'décharge toutes les 50 cellules
      ReDim Preserve a(1 To n)
      a(n) = tablo(i, j)
    End If
Next i, j
If Not coul Is Nothing Then coul.Interior.ColorIndex = 43 'ce qui reste à colorer
If n Then ListBox1.List = a
End Sub

  [C2].Resize(nlig, 2).Cut Cells(nlig + 2, 1)
  [E2].Resize(nlig, 2).Cut Cells(2 * nlig + 2, 1)
  [A:B].Sort [B1], xlAscending, [A1], , xlAscending, Header:=xlYes 'tri
  Cells(2 * nlig + 2, 1).Resize(nlig, 2).Cut [E2]
  Cells(nlig + 2, 1).Resize(nlig, 2).Cut [C2]

  [D2].Resize(nlig).Cut Cells(nlig + 2, 2)
  [F2].Resize(nlig).Cut Cells(2 * nlig + 2, 2)
  [B:B].Sort [B1], xlAscending, Header:=xlYes  'tri
  Cells(2 * nlig + 2, 2).Resize(nlig).Cut [F2]
  Cells(nlig + 2, 2).Resize(nlig).Cut [D2]