Déplacer des colonnes dans un ordre en vba

Sub ClasserColonnes()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim col%, P1 As Range, P2 As Range, i%, n
Application.ScreenUpdating = False
col = Feuil2.Cells(1, Feuil2.Columns.Count).End(xlToLeft).Column
Set P1 = Feuil1.Columns(1).Resize(, col)
Set P2 = Feuil2.Rows(1)
1 For i = 1 To col
  If P1.Cells(1, i) <> "" Then
    n = Application.Match(P1.Cells(1, i), P2, 0)
    If IsError(n) Then MsgBox "Revoyez les titres en Feuil2 !": Exit Sub
    If i <> n Then
      P1.Columns(i).Cut
      P1.Columns(n + 1).Insert
      GoTo 1
    End If
  End If
Next
Application.Goto P1.Cells(1)
End Sub

Sub ClasserColonnes()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim col1%, col%, P1 As Range, P2 As Range, i%, n
Application.ScreenUpdating = False
col1 = Feuil1.Cells(1, Feuil1.Columns.Count).End(xlToLeft).Column
col = Feuil2.Cells(1, Feuil2.Columns.Count).End(xlToLeft).Column
col = Application.Max(col1, col)
Set P1 = Feuil1.Columns(1).Resize(, col)
Set P2 = Feuil2.Rows(1)
1 For i = 1 To col
  If P1.Cells(1, i) <> "" Then
    n = Application.Match(P1.Cells(1, i), P2, 0)
    If IsError(n) Then MsgBox "Revoyez les titres en Feuil2 !": Exit Sub
    If i <> n Then
      P1.Columns(i).Cut
      P1.Columns(n - (i < n)).Insert 'True se convertit en -1
      GoTo 1
    End If
  End If
Next
Application.Goto P1.Parent.[A1]
End Sub

Sub ClasserColonnes()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim F As Worksheet, col1%, col%, P As Range, i%, n
Application.ScreenUpdating = False
Set F = Feuil1
col1 = F.Cells(1, F.Columns.Count).End(xlToLeft).Column
col = Feuil2.Cells(1, Feuil2.Columns.Count).End(xlToLeft).Column
col = Application.Max(col1, col)
Set P = Feuil2.Rows(1).Resize(, col)
1  For i = 1 To col
  If F.Cells(1, i) <> "" Then
    n = Application.Match(F.Cells(1, i), P, 0)
    If IsError(n) Then MsgBox "Revoyez les titres en Feuil2 !": Exit Sub
    If i <> n Then
      F.Columns(i).Cut
      F.Columns(n - (i < n)).Insert 'True se convertit en -1
      GoTo 1
    End If
  End If
Next
Application.Goto F.[A1]
End Sub

Sub ClasserColonnes()
Dim F1 As Worksheet, F2 As Worksheet, P As Range, i%, n
Set F1 = Feuil1: Set F2 = Feuil2 'CodeNames
Set P = Feuil2.Rows(1)
For i = 1 To F1.Cells(1, F1.Columns.Count).End(xlToLeft).Column
  If F1.Cells(1, i) <> "" Then
    n = Application.Match(F1.Cells(1, i), P, 0)
    If IsError(n) Then MsgBox "Revoyez les titres en Feuil2 !": Exit For
    F1.Columns(i).Copy F2.Cells(1, n)
  End If
Next
If IsError(n) Then F2.Rows("2:" & F2.Rows.Count).Delete
Application.Goto F2.[A1]
End Sub

Sub ClasserColonnes()
Dim F1 As Worksheet, F2 As Worksheet, col%
Dim P As Range, c As Range, r As Range
Application.ScreenUpdating = False
Set F1 = Feuil1: Set F2 = Feuil2
col = F2.Cells(1, F2.Columns.Count).End(xlToLeft).Column
Set P = F2.[A1].Resize(, col + 1)
F1.[1:1].Insert 'ligne auxiliaire
For Each c In F1.[A2].Resize(, col)
  Set r = P.Find(c, P(col + 1), xlValues, xlWhole)
  If r Is Nothing Then MsgBox "Revoyez les titres en Feuil2 !": Exit For
  c(0) = r.Column
  If r = "" Then r.EntireColumn.Hidden = True 'masque la colonne
Next
If Not r Is Nothing Then F1.Columns(1).Resize(, col) _
  .Sort F1.[A1], xlAscending, Header:=xlNo, Orientation:=xlLeftToRight 'tri
F1.[1:1].Delete 'suppression de la ligne auxiliaire
F2.Columns(1).Resize(, col).Hidden = False 'affichage des colonnes
Application.Goto F1.[A1]
End Sub

Sub essai()
Dim dercol As Integer, derlin As Integer, tablo
Dim n As Integer, m As Integer, col As Integer, y As Range
dercol = Sheets("Feuil1").Cells(1, Columns.Count).End(xlToLeft).Column
derlin = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
tablo = Sheets("Feuil1").Range(Cells(1, 1).Address & ":" & Cells(derlin, dercol).Address)
Sheets("Feuil1").Range(Cells(1, 1).Address & ":" & Cells(derlin, dercol).Address).ClearContents
Sheets("Feuil2").Rows(1).Copy Destination:=Sheets("Feuil1").Range("A1")
Application.ScreenUpdating = False
For n = LBound(tablo, 2) To UBound(tablo, 2)
  Set y = Sheets("Feuil1").Rows(1).Find(tablo(LBound(tablo, 1), n), LookIn:=xlValues, lookat:=xlWhole)
  col = y.Column
  For m = LBound(tablo, 1) + 1 To UBound(tablo, 1)
    Sheets("Feuil1").Cells(m, col) = tablo(m, n)
  Next
Next
Application.ScreenUpdating = False
End Sub

Sub ClasserColonnes()
Dim F1 As Worksheet, F2 As Worksheet, col1%, col%, c As Range, r As Range
Application.ScreenUpdating = False
Set F1 = Feuil1: Set F2 = Feuil2 'CodeNames des feuilles
col1 = F1.Cells(1, F1.Columns.Count).End(xlToLeft).Column
col = F2.Cells(1, F2.Columns.Count).End(xlToLeft).Column
col = Application.Max(col1, col)
F1.[1:1].Insert 'ligne auxiliaire
For Each c In F1.[A2].Resize(, col)
  Set r = F2.[A1].Resize(, col).Find(c, , xlValues, xlWhole)
  If r Is Nothing Then MsgBox "Revoyez les titres en Feuil2 !": Exit For
  c(0) = r.Column
  If r = "" Then r.EntireColumn.Hidden = True 'masque la colonne
Next
If Not r Is Nothing Then F1.Columns(1).Resize(, col) _
  .Sort F1.[A1], xlAscending, Header:=xlNo, Orientation:=xlLeftToRight 'tri
F1.[1:1].Delete 'suppression de la ligne auxiliaire
F2.Columns(1).Resize(, col).Hidden = False 'affichage des colonnes
Application.Goto F1.[A1]
End Sub