Classer les en-tête selon un ordre voulu après leurs extractions

Bonjour,

Je me retourne de nouveau vers vous pour solliciter votre aide. Etant novice en vba et après de longues heures de recherche, je ne parviens pas à trouver la solution.

En cherchant dans les forums, je suis parvenu à extraire des colonnes d'un fichier excel en fonction de leur en-tête.

Quand j'exécute la macro, le problème est que ces entêtes sont rangés selon l'ordre du fichier excel. Moi j'aimerais qu'ils soient rangés comme indiqué dans le code.

Voici un exemple :

Je souhaite que les entêtes soient classés de la sorte : Description adresse, Blocage, Echu, Promesse, Secteur, Agence

Colonnes = Array("Description adresse", "Blocage", "Echu", "Promesse", "Secteur", "Agence")

Le classement après exécution du code : Agence, adresse, Description adresse, Secteur, Blocage, Echu, Promesse

Je vous envoie le code que j'ai pu faire. Merci d'avance

Sub ImporterColonnes()

Dim Fichier, WbkCopy As Workbook, WbkColle As Workbook

Dim Colonnes(), Col As Integer, Resultat As Variant

'On attribue à la variable WbkColle le fichier actuel (celui qui contient la macro)

Set WbkColle = ThisWorkbook

'A adapter : Nom des entêtes de colonnes à importer

Colonnes = Array("Description adresse", "Blocage", "Echu", "Promesse", "Secteur", "Agence")

'Sélection du fichier

Fichier = Application.GetOpenFilename("Fichiers Excels, *.xlsx*")

'En cas de clic sur "ANNULER"

If Fichier <> False Then

'On ouvre le fichier en question

Set WbkCopy = Workbooks.Open(Fichier)

With WbkCopy.Sheets("essaie hebdo") '==> ADAPTER NOM de la feuille

'Boucle sur toutes les entêtes des colonnes

For Col = 1 To .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column

'teste si l'entête correspond à un des noms des colonnes à copier

Resultat = Application.Match(.Cells(1, Col), Colonnes, 0)

'Si l'entête est trouvée (colonne à copier)

If Not IsError(Resultat) Then

'Copié - Collé ==> ADAPTER NOM de la feuille ou coller ("TRUC" à remplacer)

.Columns(Col).Copy WbkColle.Sheets("Feuil1").Cells(1, Cells.Columns.Count).End(xlToLeft).Offset(0, 1)

End If

Next Col

End With

WbkCopy.Close

End If

Set WbkCopy = Nothing

Set WbkColle = Nothing

End Sub

bonjour,

essaie en remplaçant

.Columns(Col).Copy WbkColle.Sheets("Feuil1").Cells(1, Cells.Columns.Count).End(xlToLeft).Offset(0, 1)

par

.Columns(Col).Copy WbkColle.Sheets("Feuil1").Cells(1, Resultat)

Merci d'avoir répondu.

J'ai remplacé et ca marche correctement. Merci