Réorganiser nom des colonnes d'un fichier à partir d'un fichier référence

Remteyss

XLDnaute Junior
Bonjour,

Je cherche à écrire une macro que j'ai beaucoup de mal à traduire en VBA.
Je possède deux fichiers ; l'un est le fichier de référence (fichier A) et le second (fichier B) est le nouveau fichier.
Ces deux fichiers possèdent une multitude de colonnes mais tous les noms de ces colonnes ne sont pas identiques.
Je m'explique ;
- Certaines colonnes du fichier A ne sont pas présentes dans le B ; on les ignore, pas besoin de les ajouter
- Certaines colonnes du fichier B ne sont pas présentes dans le A ; pas besoin de modifier leur positon mais elles peuvent être décalées de x colonnes si d'autres noms sont insérés avant
- Certaines colonnes du fichier B ne sont pas situés à la même position dans le fichier A et dans le fichier B : il faut les réorganiser

C'est le dernier point qui me pose un problème particulier. Ne pouvant pas joindre les fichiers, voici un exemple :
Noms des colonnes du fichier A : Nom | Prénom | Age | Sexe | Taille | Pays | Région
Noms des colonnes du fichier B : Nom | Age | Sexe | Prénom | Région | Poids | Pays

Après exécution de la macro, il faudrait que les noms des colonnes du fichier B apparaissent comme ça :
Nom | Prénom | Age | Sexe | Pays | Région | Poids
ou comme ça :
Nom | Prénom | Age | Sexe | Poids | Pays | Région
voir même comme ça :
Nom | Prénom | Age | Sexe | Pays | Poids | Région

J'ai présenté trois possibilités afin de montrer que la position de la colonne "Poids" n'a pas d'importance ; le repositionnement de "Pays" et "Région" n'en dépend pas.

J'espère que vous parviendrez à comprendre le but de ma macro...

Je vous remercie par avance de l'aide que vous pourriez m'apporter !
 

job75

XLDnaute Barbatruc
Bonjour Remteyss,

Téléchargez les fichier joints dans le même dossier (le bureau) et exécutez cette macro :
VB:
Sub Classement_colonnes()
Dim chemin$, dest As Worksheet, source As Worksheet, col%, i As Variant
chemin = ThisWorkbook.Path & "\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
Set dest = Workbooks.Open(chemin & "B.xlsx").Sheets(1)
Set source = Workbooks.Open(chemin & "A.xlsx").Sheets(1)
With dest.UsedRange
    .Rows(1).Insert xlDown
    For col = 1 To .Columns.Count
        i = Application.Match(.Cells(1, col), source.UsedRange.Rows(1), 0)
        If IsNumeric(i) Then .Cells(0, col) = i
    Next
    Union(.Rows(0), .Cells).Sort .Rows(0), xlAscending, Orientation:=2 'tri horizontal
    .Rows(0).Delete xlUp
End With
End Sub
A+
 

Pièces jointes

  • Classement colonnes(1).xlsm
    17.9 KB · Affichages: 4
  • A.xlsx
    9.3 KB · Affichages: 3
  • B.xlsx
    10.4 KB · Affichages: 3

Remteyss

XLDnaute Junior
Bonjour,
Merci pour votre rapide retour. Cela semble correspondre, je vais essayer de l'adapter à mon fichier.
Cependant, dans le cas ou mes deux fichiers ont un nombre de colonnes différent, cela fonctionnerait quand même ?


Le nombre de cellules ne semble pas empêché la macro de tourner.
J'obtiens cependant le message d'erreur suivant : "Erreur d'exécution "1004". Pour cela, la taille des cellules fusionnées doivent être de la même taille."
Pourtant, je n'utilise pas de cellules fusionnées sur la ligne que je souhaite trier. Des noms avec menu déroulant peuvent-ils être à l'origine de l'erreur ?
 

Remteyss

XLDnaute Junior
Je cherchais à trier uniquement les en têtes car j'ai initialement créé une macro permettant de coller rechercher dans le fichier source les lignes qui m'intéressent puis de les coller dans le fichier de destination. Puis je me suis aperçu que les colonnes ne correspondaient pas...
Mais en effet votre option pourrait faciliter mon code

Les cellules fusionnées se situent à la toute première ligne puis les en têtes en seconde ligne.
 

job75

XLDnaute Barbatruc
Les cellules fusionnées se situent à la toute première ligne puis les en têtes en seconde ligne.
Alors ce n'est vraiment pas sorcier, il suffit d'éviter la 1ère ligne en utilisant Offset(1) :
VB:
Sub Classement_colonnes()
Dim chemin$, dest As Worksheet, source As Worksheet, col%, i As Variant
chemin = ThisWorkbook.Path & "\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
Set dest = Workbooks.Open(chemin & "B.xlsx").Sheets(1)
Set source = Workbooks.Open(chemin & "A.xlsx").Sheets(1)
With dest.UsedRange.Offset(1) 'pour éviter la 1ère ligne fusionnée
    .Rows(1).Insert xlDown
    For col = 1 To .Columns.Count
        i = Application.Match(.Cells(1, col), source.UsedRange.Rows(1), 0)
        If IsNumeric(i) Then .Cells(0, col) = i
    Next
    Union(.Rows(0), .Cells).Sort .Rows(0), xlAscending, Orientation:=2 'tri horizontal
    .Rows(0).Delete xlUp
End With
End Sub
Voyez le fichier B.xlsx avec la 1ère ligne fusionnée.
 

Pièces jointes

  • Classement colonnes(2).xlsm
    18.3 KB · Affichages: 5
  • A.xlsx
    9.3 KB · Affichages: 3
  • B.xlsx
    10.7 KB · Affichages: 4

Remteyss

XLDnaute Junior
Alors ce n'est vraiment pas sorcier, il suffit d'éviter la 1ère ligne en utilisant Offset(1) :
VB:
Sub Classement_colonnes()
Dim chemin$, dest As Worksheet, source As Worksheet, col%, i As Variant
chemin = ThisWorkbook.Path & "\" 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
Set dest = Workbooks.Open(chemin & "B.xlsx").Sheets(1)
Set source = Workbooks.Open(chemin & "A.xlsx").Sheets(1)
With dest.UsedRange.Offset(1) 'pour éviter la 1ère ligne fusionnée
    .Rows(1).Insert xlDown
    For col = 1 To .Columns.Count
        i = Application.Match(.Cells(1, col), source.UsedRange.Rows(1), 0)
        If IsNumeric(i) Then .Cells(0, col) = i
    Next
    Union(.Rows(0), .Cells).Sort .Rows(0), xlAscending, Orientation:=2 'tri horizontal
    .Rows(0).Delete xlUp
End With
End Sub
Voyez le fichier B.xlsx avec la 1ère ligne fusionnée.

Super je vous remercie pour votre aide !
 

Discussions similaires

Statistiques des forums

Discussions
312 210
Messages
2 086 279
Membres
103 170
dernier inscrit
HASSEN@45