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
2renenkyo.xlsm (18.79 Ko)

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+

8renenkyo.xlsm (20.27 Ko)
Rechercher des sujets similaires à "copier colonne position variable"