Copier colonne en fonction de son en-tête

Bonjour, je possède un fichier Excel avec une liste de données classées par colonne. Chaque colonne possède une en-tête. J'aimerais sur le même fichier Excel mais dans une autre feuille copier automatiquement une colonne en fonction de son en-tête. Des idées ?

Merci de votre aide !

Bonjour,

Et quel est ton problème ?

un exemple :

Sub test()
 copieCol "Prénom"
End Sub

Sub copieCol(titre As String)
    Dim c As Range
    Set c = [1:1].Find(titre, LookIn:=xlValues, lookat:=xlWhole)
    If c Is Nothing Then
        MsgBox "Titre non trouvé"
    Else
        c.EntireColumn.Copy Sheets("Feuil2").[A:A]
    End If
End Sub

Copie la colonne Prénom de la feuille active dans Feuil2!A:A (si ce sont des valeurs, pas des formules)

eric

Bonjour

Après avoir lu votre message j'ai tenté de l'utiliser sur mon tableau :

Je cherche a copier des colonnes d'une feuille 1 nommé "Tri"

Sur la feuille "Tableau Valeurs"

Je retrouve plusieurs colonnes avec diverses nom : D)FOURNISSEUR; I)TYPE ....

et je voudrais que le logiciels les copie dans les bonnes colonnes sur la 2eme feuille

J'ai actuellement ce code qui marche :

Sub Copie_collone_Test2()
'
' Copie_collone_Test2 Macro
'
Dim marque As Range

Set marque = [1:1].Find("D)FOURNISSEUR", LookIn:=xlValues, lookat:=xlWhole)
Sheets("Tri").Select
If marque Is Nothing Then
MsgBox "Titre marque non trouvé"
Else
marque.EntireColumn.Copy Sheets("Tableau Valeurs").[G:G]
End If
'
End Sub

mais dès que je cherche à le faire pour plusieurs colonnes :

Sub Copie_collone_Test2()
'
' Copie_collone_Test2 Macro
'
Dim marque As Range

Set marque = [1:1].Find("D)FOURNISSEUR", LookIn:=xlValues, lookat:=xlWhole)
Sheets("Tri").Select
If marque Is Nothing Then
MsgBox "Titre marque non trouvé"
Else
marque.EntireColumn.Copy Sheets("Tableau Valeurs").[G:G]
End If

Dim Ty As Range

Set Ty = [1:1].Find("I)TYPE", LookIn:=xlValues, lookat:=xlWhole)
Sheets("Tri").Select
If Ty Is Nothing Then
MsgBox "Titre type non trouvé"
Else
Ty.EntireColumn.Copy Sheets("Tableau Valeurs").[k:k]
End If
'
End Sub

Le code ne marche plus ...

Je dois le faire pour 5 ou 6 colonnes au final

Pouvez vous m'aider ?

Merci d'avance

eriiic a écrit :

Bonjour,

Et quel est ton problème ?

un exemple :

Sub test()
 copieCol "Prénom"
End Sub

Sub copieCol(titre As String)
    Dim c As Range
    Set c = [1:1].Find(titre, LookIn:=xlValues, lookat:=xlWhole)
    If c Is Nothing Then
        MsgBox "Titre non trouvé"
    Else
        c.EntireColumn.Copy Sheets("Feuil2").[A:A]
    End If
End Sub

Copie la colonne Prénom de la feuille active dans Feuil2!A:A (si ce sont des valeurs, pas des formules)

eric

J'ai tenté comme expliqué au dessus ce code mais un problème survient lorsque je veux le faire pour plusieurs...

Bonjour,

ne marche pas ne veux rien dire.

eric

eriiic a écrit :

Bonjour,

ne marche pas ne veux rien dire.

eric

Oui désolé je n'avais pas été précis dans mon message :

le logiciels me mettais un bug a partir de la ligne suivante :

Ty.EntireColumn.Copy Sheets("Tableau Valeurs").[k:k]

Mais sur un autre sujet quelqu’un ma répondu apres que je lui ai envoyé un modèle et proposé ce code qui marche très bien :

Sub Test()

Dim wss, wsd As Worksheet

Set wss = Worksheets("Tri")

Set wsd = Worksheets("Tableau Valeurs")

Dim LRow As Long, Found As Range

Set Found = wss.Range("A1:I1").Find("D)FOURNISSEUR")

If Not Found Is Nothing Then

LRow = wss.Cells(wss.Rows.Count, Found.Column).End(xlUp).Row

wss.Range(wss.Cells(1, Found.Column), wss.Cells(LRow, Found.Column)).Copy

wsd.Range("G1").PasteSpecial xlPasteValues

End If

Set Found = wss.Range("A1:I1").Find("I)TYPE")

If Not Found Is Nothing Then

LRow = wss.Cells(wss.Rows.Count, Found.Column).End(xlUp).Row

wss.Range(wss.Cells(1, Found.Column), wss.Cells(LRow, Found.Column)).Copy

wsd.Range("K1").PasteSpecial xlPasteValues

End If

End Sub

Désolé pour le dérangement