vba : Ranger dans le même ordre les colonnes de 2 feuilles excel différentes

[prozqck]

Bonjour à tous,

Je bloque sur le codage d'un programme vba :

J'ai 2 feuilles excel d'un même classeur comportant des données similaires et dont les string des entêtes de colonnes sont identiques, elles ne sont simplement pas ranger dans le même ordre. L'idée est de coder un petit module VBA qui me permettrait d'automatiser le tri de colonnes, car cette manipulation devient vite lourde a faire a la main, surtout quand on a 80 fichiers a se farcir !

Il faudrait donc prendre l'ordre des colonnes de la feuille 1 en référence, repérer les colonnes ayant la même entête dans la feuille 2, les ranger dans le même ordre, puis supprimer les colonnes qui ne sont pas en concordances dans les 2 feuilles (ou supprimer d'abord puis ranger ensuite...)

Je joint un fichier excel dans lequel j'explique si je ne suis pas assez clair ici. Bien sur il est simplifié a titre d'exemple, mais j'ai plusieurs fichiers a trier de plus de 50 colonnes, ca devient vite très fastidieux.

Merci de votre aide !

 

[PMO2]

Re : vba : Ranger dans le même ordre les colonnes de 2 feuilles excel différentes

Bonjour,

Une piste avec le code suivant à copier dans un module standard

Sub SupprimerTrierColonnes()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim var1
Dim var2
Dim i&
Dim j&
Dim bool As Boolean
Dim cpt&
With ActiveWorkbook.Windows(1)
  If .SelectedSheets.Count <> 2 Then
    MsgBox "Veuillez sélectionner 2 feuilles." & vbCrLf & vbCrLf & _
      "Sélectionnez en premier la feuille de référence."
    Exit Sub
  End If
  Set S1 = .SelectedSheets(1)
  MsgBox S1.Name
  Set S2 = .SelectedSheets(2)
  If S1.[a1] = "" Or S2.[a1] = "" Then
    MsgBox "La cellule A1 doit être renseignée."
    Exit Sub
  End If
End With
var1 = S1.[a1].CurrentRegion
var2 = S2.[a1].CurrentRegion
'--- Supprime les colonnes sans correspondance ---
    '°°° feuille1 vs feuille2 °°°
For i& = UBound(var2, 2) To 1 Step -1
  bool = False
  For j& = 1 To UBound(var1, 2)
    If UCase(Trim(var2(1, i&))) = UCase(Trim(var1(1, j&))) Then
      bool = True
      Exit For
    End If
  Next j&
  If Not bool Then S2.Columns(i&).Delete
Next i&
    '°°° feuille2 vs feuille1 °°°
For i& = UBound(var1, 2) To 1 Step -1
  bool = False
  For j& = 1 To UBound(var2, 2)
    If UCase(Trim(var1(1, i&))) = UCase(Trim(var2(1, j&))) Then
      bool = True
      Exit For
    End If
  Next j&
  If Not bool Then S1.Columns(i&).Delete
Next i&
'--- Réorganiser les colonnes ---
var1 = S1.[a1].CurrentRegion
var2 = S2.[a1].CurrentRegion
cpt& = UBound(var1, 2) + 1
For i& = UBound(var1, 2) To 1 Step -1
  For j& = 1 To UBound(var2, 2)
    If UCase(Trim(var1(1, i&))) = UCase(Trim(var2(1, j&))) Then
      If i& <> j& Then
        S2.Columns(j&).Cut
        S2.Columns(i& + 1).Insert
        var2 = S2.[a1].CurrentRegion
      End If
    End If
  Next j&
Next i&
End Sub

Marche à suivre
1) sélectionnez l'onglet de la feuille de référence
2) maintenez la touche Ctrl et sélectionnez l'onglet de la 2ème feuille
les 2 feuilles doivent être sélectionnées
3) lancez la macro SupprimerTrierColonnes

ATTENTION : faites les tests sur des copies de vos classeurs et vérifiez bien si vous obtenez le résultat attendu.

Cordialement.

PMO
Patrick Morange