Copie de colonne en fonction de l'en-tête

Bonjour

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

Salut VeGaLis,

le code doit fonctionner, il faut juste donner à la macro un autre nom que "Sub Copie_collone_Test2". Par ex: "Sub Copie_collone_Test3"

Sinon montre nous un fichier Test, il y a peut être un moyen de faire cette manipe autrement

@+++

Salut VeGaLis,

le code doit fonctionner, il faut juste donner à la macro un autre nom que "Sub Copie_collone_Test2". Par ex: "Sub Copie_collone_Test3"

Sinon montre nous un fichier Test, il y a peut être un moyen de faire cette manipe autrement

@+++

Comment ça changer le nom ?

C'est peut etre idiot ce que je dit mais ca ne va pas créer une autre macro ?

L'objectif serait de tous faire en 1 click

Ci joint un fichier test

Merci d'avance

6copie-colonne.xlsx (117.09 Ko)

Re,

essaie cette macro:

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

@++

J'avais mal tester pour ton premier message et ca marche très bien

je testerais la macro que tu ma envoyé d'ici demain ...

Merci encore

Bonne continuation

Re,

sinon avec un Array bidimensionnel

Sub Test()
Dim wss, wsd As Worksheet
Dim myHeaders

Set wss = Worksheets("Tri")
Set wsd = Worksheets("Tableau Valeurs")

Dim LRow As Long, Found As Range

myHeaders = Array(Array("D)FOURNISSEUR", "G1"), Array("I)TYPE", "K1")) ' ici tu definis les Titres et les colonnes de destination 

For Each e In myHeaders
Set Found = wss.Range("A1:I1").Find(e(0))

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(e(1)).PasteSpecial xlPasteValues
End If
Next
End Sub

Bonne chance

J'ai testé et ca marche très bien, j’arrive facilement a rentrer d'autres colonnes donc merci encore.

Si j'ai bien compris, on recréer un autre tableau dans la 2eme feuille, j'avoue ne pas avoir encore tout compris mais je fais des recherche de mon cotes.

Je cherche également a rajouter un msg comme dans le premier code qui m'indique les colonnes que j'appelle mais qui ne sont pas présente dans le tableau :

Sub Test2()

Dim wss, wsd As Worksheet

Dim myHeaders

Set wss = Worksheets("Tri")

Set wsd = Worksheets("Tableau Valeurs")

Dim LRow As Long, Found As Range

myHeaders = Array(Array("D)FOURNISSEUR", "G1"), Array("I)TYPE", "K1"), Array("E)DIAMETRE", "H1")) ' ici tu definis les Titres et les colonnes de destination

For Each e In myHeaders

Set Found = wss.Range("A1:I1").Find(e(0))

If Not Found Is Nothing Then

MsgBox "Titre non trouvé"

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(e(1)).PasteSpecial xlPasteValues

End If

Next

End Sub

En fessant comme ceci j’arrive a avoir un message qui me dit sil manque des colonnes mais pour avoir le nom de la colonne qui manque faut t’il créer d'autres variables ?

Merci encore

Salut VeGaLis,

essaie comme ca:

Sub Test2()
Dim wss, wsd As Worksheet
Dim myHeaders

Set wss = Worksheets("Tri")
Set wsd = Worksheets("Tableau Valeurs")

Dim LRow As Long, Found As Range

myHeaders = Array(Array("D)FOURNISSEUR", "G1"), Array("I)TYPE", "K1"), Array("E)DIAMETRE", "H1")) ' ici tu definis les Titres et les colonnes de destination

For Each e In myHeaders
Set Found = wss.Range("A1:I1").Find(e(0))

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(e(1)).PasteSpecial xlPasteValues
Else
MsgBox "Titre non trouvé"
End If
Next
End Sub

Si j'ai bien compris, on recréer un autre tableau dans la 2eme feuille, j'avoue ne pas avoir encore tout compris mais je fais des recherche de mon cotes.

Non en fait ca depend de ce que tu veux faire, si le but est d'ajouter les données dans les colonnes existantes, il faut qu'on adapte le code, pour qu'il cherche la première céllule vide dans la colonne souhaitée et puis insérer les nouvelles données...

@+++

Non en fait ca depend de ce que tu veux faire, si le but est d'ajouter les données dans les colonnes existantes, il faut qu'on adapte le code, pour qu'il cherche la première céllule vide dans la colonne souhaitée et puis insérer les nouvelles données...

@+++

Oui je suis actuellement en train de chercher comment faire.

Je regarde les formules Somme.Si.Ens

Dans mon idée je pensais faire 2 macros différentes, dans un premier temps : une qui regroupe les lignes identiques et créant une colonne quantité qui pour ne pas avoir de doublon

Puis la deuxième celle pour laquelle tu m'a deja aider pour trier les colonnes et les mettre a la bonne place dans le tableau.

Apres peut etre regrouper les 2 mais ce n'est pas la priorité

Cordialement VeGaLis

Rechercher des sujets similaires à "copie colonne fonction tete"