Copier une colonne à position variable
Bonjour à toutes et à tous,
Je suis débutante dans le domaine du macrotage vba et j'aurais besoin d'un petit coup de main.
J'ai tapé une petite macro qui viens coller des colonnes d'une feuille sur les colonnes d'une autre feuille.
Le hic, c'est que les colonnes de destination ne change pas alors que celles de départ peuvent varié de place.
Je m'explique, voici la partie de ma macro que je souhaite modifier:
'Copie la Fournisseur
Sheets("FeuilDepart").Range("C2:C" & derniereLigne).Copy
Sheets("FeuilDestination").Range("A5").PasteSpecial Paste:=xlPasteValues
'Copie la Matériel
Sheets("FeuilDepartl").Range("D2:D" & derniereLigne).Copy
Sheets("FeuilDestination").Range("C5").PasteSpecial Paste:=xlPasteValues
'Copie la Description
Sheets("FeuilDepart").Range("E2:E" & derniereLigne).Copy
Sheets("FeuilDestination").Range("B5").PasteSpecial Paste:=xlPasteValues
'Copie la Quantité
Sheets("FeuilDepart").Range("G2:G" & derniereLigne).Copy
Sheets("FeuilDestination").Range("D5").PasteSpecial Paste:=xlPasteValues
'Copie la Information
Sheets("FeuilDepart").Range("X2:X" & derniereLigne).Copy
Sheets("FeuilDestination").Range("F5").PasteSpecial Paste:=xlPasteValues
'Copie la Stock
Sheets("FeuilDepart").Range("Y2:Y" & derniereLigne).Copy
Sheets("FeuilDestination").Range("H5").PasteSpecial Paste:=xlPasteValues
Dans l'idée, la première ligne de Sheets("FeuilDepart") comporte des intitulés (Fournisseur, Matériel, Description,...) et je souhaiterai que ma macro viennes chercher ces intitulés en référence pour copier une colonne plutôt que le nom de celle-ci (A, B, C, ...)
Quelqu'un aurais un idée, pouvant être compris par une néophyte comme moi s'il vous plait?
Merci à vous!
Bonjour,
Tu peux nommer des colonnes, en cliquant sur l'entête et lui donnant un nom.
Ensuite en VBA, tu peux :
Range("NomDeMaColonne")
Il y a de l'idée mais le soucis est que j'importe d'un autre logiciel le tableau qui se trouve dans feuille de départ et c'est là que certaine colonne peuvent ne pas être à la bonne place.
Si je suis ton conseil, il me faudra renommer à la main chaque colonne a chaque fois que j'importe un tableau ce qui n'est pas vraiment pratique alors que les valeurs des cellules de la première ligne seront toujours là et les même vu qu'elles font parti du tableau importé.
Bonjour Renenkyo,
Il te faut attribuer la colonne à une variable en effectuant la recherche avec son nom :
Set Fournisseur = Sheets("FeuilDepartl").Rows(1).Find("Fournisseur", LookIn:=xlValues, LookAt:=xlWhole)
If Not Fournisseur Is Nothing Then Col_Fournisseur = Fournisseur.Column
Sheets("FeuilDepart").Range(Cells(2,Col_Fournisseur),Cells(derniereLigne,Col_Fournisseur)).Copy
Sheets("FeuilDestination").Range("A5").PasteSpecial Paste:=xlPasteValues
A dispo pour plus d'explication
Océane
Oh, Parfait ça!
Ça marche du feu de dieu!
Merci à toi Océane.
Me revoilà!
J'ai voulu adapter les lignes de code dans des fonction afin de pouvoir les utiliser dans divers fonction.
Le soucis c'est que cela me met une erreur et je ne comprend pas pourquoi.
Donc je suit parti de ça, qui marchais implacable.
Sub Macro1 ()
Set Fonc = Sheets("FeuilDepart").Rows(1).Find("Fonction (=)", LookIn:=xlValues, LookAt:=xlWhole)
If Not Fonc Is Nothing Then Col_Fonc = Fonc.Column
Sheets("FeuilDepart").Range(Cells(2, Col_Fonc), Cells(derniereLigne, Col_Fonc)).Copy
Sheets("FeuilDestination").Range("I5").PasteSpecial Paste:=xlPasteValues
End Sub
A ceci, qui me donne l'erreur "Erreur d'exécution '1004': Erreur définie par l'application ou par l'objet".
Sub Macro1()
derniereLigne = Detecte_Dernière_Ligne(3, "Données See Electrical", "G")
Col_Fonc = Position_Colonne_Fonction
Sheets("FeuilDepart").Range(Cells(2, Col_Fonc), Cells(derniereLigne, Col_Fonc)).Copy
Sheets("FeuilDestination").Range("I5").PasteSpecial Paste:=xlPasteValues
End Sub
_______________
Function Position_Colonne_Fonction()
Set Fonc = Sheets("FeuilDepart").Rows(1).Find("Fonction (=)", LookIn:=xlValues, LookAt:=xlWhole)
If Not Fonc Is Nothing Then Position_Colonne_Fonction = Fonc.Column
End Function
Une idée sur l'erreur possible?
Re Renenkyo,
Selon moi, je ne suis pas une pro mais ta fonction est mal utilisé :
Sub Macro1()
derniereLigne = Detecte_Dernière_Ligne(3, "Données See Electrical", "G")
Col_Fonc = Position_Colonne_Fonction("Fonction (=)")
Sheets("FeuilDepart").Range(Cells(2, Col_Fonc), Cells(derniereLigne, Col_Fonc)).Copy
Sheets("FeuilDestination").Range("I5").PasteSpecial Paste:=xlPasteValues
End Sub
Function Position_Colonne_Fonction(Entete As String)
Set Fonc = Sheets("FeuilDepart").Rows(1).Find(Entete, LookIn:=xlValues, LookAt:=xlWhole)
If Not Fonc Is Nothing Then Position_Colonne_Fonction = Fonc.Column
End Function
A dispo
Océane
La fonction renvoie bien la valeur pourtant.
J'ai essayé ta méthode mais j'ai toujours la même erreur.
Renenkyo,
As-tu testé la macro en pas à pas ?
Chez moi cela fonctionne bien, possible que cela vienne de ta fonction Detecte_Dernière_Ligne ?
Salut Renenkyo,
Salut Oxydum, Océane,
quelque chose comme ça ?
tLib = Array("Entreprise", "Fournisseurs", "Directeur", "Agents")
Cette liste contiendrait les intitulés de colonne à rechercher. Ici, par défaut, leur emplacement en 'BDD' correspond à leur position dans la liste : colonne [A] pour "Entreprise", etc...
La macro cherche dans ton import en feuille 'Import' la bonne colonne selon l'intitulé (es-tu certaine de la correspondance des orthographes ?), efface les données existantes en 'BDD' et copie les données d'Import'.
La macro se trouve dans le module VBA de 'Import' mais on peut la déplacer où tu veux.
Un double-clic en 'Import' démarre la macro.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim rCel As Range, tTab, tLib(), iRow%
'
Cancel = True
tLib = Array("Entreprise", "Fournisseurs", "Directeur", "Agents")
'
On Error Resume Next
Application.ScreenUpdating = False
'
With Worksheets("BDD")
For x = 1 To 4
Set rCel = Rows(1).Find(what:=CStr(tLib(x - 1)), lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)
If Not rCel Is Nothing Then
sCol = Split(Columns(rCel.Column).Address(ColumnAbsolute:=False), ":")(1)
iRow = .Range(Choose(x, "A", "B", "C", "D") & Rows.Count).End(xlUp).Row
If iRow > 1 Then .Range(Choose(x, "A", "B", "C", "D") & "2:" & Choose(x, "A", "B", "C", "D") & iRow).Value = ""
iRow = Range(sCol & Rows.Count).End(xlUp).Row
If iRow > 1 Then .Range(Choose(x, "A", "B", "C", "D") & 2).Resize(iRow - 1, 1).Value = Range(sCol & 2).Resize(iRow - 1, 1).Value
Else
sMsg = sMsg & IIf(sMsg = "", "", ", " & tLib(x - 1))
End If
Next
.Activate
End With
If sMsg <> "" Then MsgBox "Les colonnes libellées" & Chr(10) & sMsg & Chr(10) & "sont manquantes !", vbInformation + vbOKOnly, "Renenkyo at work"
'
Application.ScreenUpdating = True
On Error GoTo 0
'
End Sub
Salut Renenkyo,
Salut Oxydum, Océane,
version améliorée selon les indications du code original avec, énumérés dans le tableau tLib(), les libellés de colonne recherchés dans ton import et les colonnes de destination correspondantes dans 'BDD'.
tLib = Array("Fournisseurs", "A", "Description", "B", "Matériel", "C", "Quantité", "D", "Information", "F", "Stock", "H")
Je t'invite, pour tester le code, à coller ton import dans 'Import' puis double-clic dans 'BDD'.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim rCel As Range, tLib(), iRow%, sCol1$, sCol2$
'
Cancel = True
tLib = Array("Fournisseurs", "A", "Description", "B", "Matériel", "C", "Quantité", "D", "Information", "F", "Stock", "H")
'
On Error Resume Next
Application.ScreenUpdating = False
'
With Worksheets("Import")
For x = 0 To UBound(tLib) - 1 Step 2
sCol1 = CStr(tLib(x + 1))
Range(sCol1 & ":" & sCol1).Value = ""
Set rCel = .Rows(1).Find(what:=CStr(tLib(x)), lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)
If Not rCel Is Nothing Then
sCol2 = Split(Columns(rCel.Column).Address(ColumnAbsolute:=False), ":")(1)
iRow = .Range(sCol2 & Rows.Count).End(xlUp).Row
If iRow > 1 Then Range(sCol1 & 1).Resize(iRow, 1).Value = .Range(sCol2 & 1).Resize(iRow, 1).Value
End If
Next
End With
'
Application.ScreenUpdating = True
On Error GoTo 0
'
End Sub
A+