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
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