XL 2021 Boucle copier-coller par nom d'en-tête de colonnes

[whiteshark]

Bonjour à tous !

Je fais une fois de plus appel à la communauté pour m’aider.

Je voudrais optimiser un code grâce à une boucle mais j’ai beaucoup de mal avec ce genre d’outil.
J’ai un fichier de traitement de données dans lequel je rapatrie les données à partir d’exports qu’on me fournit. Les en-têtes de colonnes sont toujours les mêmes mais les colonnes peuvent changées de place en fonction de l’export. Donc j’utilise le code suivant qui me permet de chercher une colonne du fichier export grâce à son en-tête et de copier où je veux dans le fichier traitement.

Dim Cel As Range

Windows("Export").Activate
Set Cel = Cells.Find(what:="nom de l’en-tête de la colonne")
If Not Cel Is Nothing Then
Cells(1, Cel.Column).Resize(Cells(Rows.Count, Cel.Column).End(xlUp).Row).Copy
ThisWorkbook.Sheets("traitement").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If

Ça marche parfaitement mais j’ai autant de bloque comme celui-ci par colonne à copier et j’en ai beaucoup.
Je voudrais savoir s’il est possible d’utiliser ce bloc qu’une seule fois en boucle sur une liste d’en-têtes de colonnes. En gros ça chercherait le 1er en-tête de la liste dans l’export, ça copierait la colonne, ça chercherait ce même nom d’en-tête dans le fichier traitement, ça collerait la colonne et on recommence avec le 2ème en-tête et ainsi de suite.
Je vous donne un fichier d’exemple où le bouton Copie lance le code que j’utilise actuellement pour 3 colonnes en copiant les infos de l’onglet export vers l’onglet traitement. Dans l’onglet Paramètre il y a la liste des noms d’en-tête pour la boucle que j’aimerais avoir.

Voilà ! J’espère que j’ai été assez clair dans mes explications et que vous pourrez m’aider. Ça allègerait grandement mon fichier de traitement et en plus ça pourrait me servir pour plus tard.

Je vous dis merci d’avance et bonne journée à tous !

 

[Cousinhub]

Bonjour,
Une solution utilisant un mix VBA (pour mise à jour) et Power Query (pour obtenir le résultat)
Si cela t'intéresse...
Bonne journée

 

[whiteshark]

Ah j'ai pas pensé à préciser que je voulais éviter Power Query je connais absolument pas et j'ai peur que ça rentre en conflit avec d'autres choses des fichiers (c'est peut être pas possible mais comme j'y connais rien...)

Mais merci beaucoup pour ta réponse !

 

[dysorthographie]

Bonjour,

Sub Test()
Feuille "Export", "Traitement"
End Sub
Sub Feuille(ShSource As String, ShCible As String)
Dim ColectSource As Collection, I As Integer
Set ColectSource = EntetesCollection(Sheets(ShSource))
With Sheets(ShCible).Range("A1").CurrentRegion
    .Range(.Cells(2, 1), .Cells(.Rows.Count + 2, .Columns.Count)).Delete
    For I = 1 To .Columns.Count
          Sheets(ShSource).Columns(ColectSource(.Cells(1, I).Text)).Copy .Cells(1, I)
    Next
End With
End Sub
Function EntetesCollection(Sh As Worksheet) As Collection
Dim I As Integer, Col As New Collection
With Sh.Range("A1").CurrentRegion
    For I = 1 To .Columns.Count
        Col.Add I, .Cells(1, I).Value
    Next
End With
Set EntetesCollection = Col
End Function

 

[sylvanu]

Bonjour Whiteshark, Cousinhub,
Une solution en VBA avec :

Sub CopieColonnes()
Application.ScreenUpdating = False
With Sheets("Paramètres")       ' Tableau liste colonnes
    DL = .Cells(.Cells.Rows.Count, "A").End(xlUp).Row
    ListeCol = .Range("A2:A" & DL)
End With
With Sheets("Export")           ' Tableau export
    DL = .Cells(.Cells.Rows.Count, "A").End(xlUp).Row
    DC = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Export = .Range(.Cells(1, 1), .Cells(DL, DC))
End With
' Restitution
ReDim Trait(1 To UBound(Export), 1 To UBound(Export, 2))
Cells.ClearContents
For C = 1 To UBound(ListeCol)
    Nom = ListeCol(C, 1)                        ' Nom colonne
    For C2 = 1 To UBound(Export, 2)
        If Export(1, C2) = Nom Then
            For L = 1 To UBound(Export)
                Trait(L, C) = Export(L, C2)     ' Si ok alors on transfert la colonne
            Next L
        End If
    Next C2
Next C
[A1].Resize(UBound(Trait, 1), UBound(Trait, 2)) = Trait ' On restitue les données
End Sub

 

[whiteshark]

Bonjour dysorthographie, bonjour sylvanu,
Merci beaucoup pour vos réponses.

dysorthographie ça marche nickel mais j'ai juste une petite question. Dans l'exemple que j'ai donné tout est sur le même fichier mais en réalité ce sont 2 fichiers Excel différents. Comment je peux introduire cette notion (quelque chose du genre Windows("Export").Activate et ThisWorkbook.Sheets("traitement").Activate) ?
Par exemple si mon fichier s'appelle "Traitement général" et la feuille "Traitement 1" et l'autre fichier s'appelle "Export général" et la feuille qui m'intéresse "Export 1" ? j'essaie de comprendre ton code mais j'avoue ça dépasse un peu mes compétences.

sylvanu ça marche aussi très bien mais du coup même question que pout dysorthographie, comment introduire la notion de fichiers différents ? En mettant quelque chose comme
With ThisWorkbook.Sheets("Paramètres") et Workbook.Sheets("Export") ?
De plus j'ai essayer d'ajouter une info dans la liste mais je ne sais pas quels paramètres changer pour que la 4ème colonne soit prise en comptes .

 

[whiteshark]

Autant pour moi sylvanu c'est moi qui n'avais pas écrit info correctement dans la liste (erreur de majuscule)
j'ai pu ajouter la colonne très facilement du coup

 

[dysorthographie]

voila

Sub Test()
Feuille Workbooks("Export.xlsx").Sheets("Export"), ThisWorkbook.Sheets("traitement")
End Sub
Sub Feuille(ShSource As Worksheet, ShCible As Worksheet)
Dim ColectSource As Collection, I As Integer
Set ColectSource = EntetesCollection(ShSource)
With ShCible.Range("A1").CurrentRegion
    .Range(.Cells(2, 1), .Cells(.Rows.Count + 2, .Columns.Count)).Delete
    For I = 1 To .Columns.Count
          ShSource.Columns(ColectSource(.Cells(1, I).Text)).Copy .Cells(1, I)
    Next
End With
End Sub
Function EntetesCollection(Sh As Worksheet) As Collection
Dim I As Integer, Col As New Collection
With Sh.Range("A1").CurrentRegion
    For I = 1 To .Columns.Count
        Col.Add I, .Cells(1, I).Value
    Next
End With
Set EntetesCollection = Col
End Function

 

[whiteshark]

Merci beaucoup ça marche parfaitement !!!

 

[sylvanu]

Re,
Une V2.
Si les deux fichiers sont dans le même dossier.
J'ai rectifié le problème de majuscule dans Paramètres.

 

[whiteshark]

Merci beaucoup sylvanu ça marche parfaitement aussi