Copier-coller colonne à partir d'une entête VBA

Bonjour à vous,

Je souhaite effectuer un copier-coller d'une colonne "A" d'un fichier "A" vers un fichier B. Cependant mon fichier "A" étant évolutif, je veux copier la colonne à partir du titre de celle-ci (les colonnes ne sont pas sous la forme d'un tableau) et non à partir de la lettre de la colonne (ce que je fais pour le moment)...

L'objectif et de pouvoir insérer de nouvelles colonnes ou l'on veux sans changer les données copier-collers.

Ce que je demande est-il réalisable ?

Mon code pour le moment :

Sub OuvrirData()

Dim Chemin As String
Dim NomFichier As String

Chemin = "M:\donnees\metiers\TEID\400-TEID1_Production_Engineering\050-ALM\08_FRACHEA Pierre-Adrien\Maintenance Moyens\FSW\" 'Format du chemin "XX\XX\XX\"

NomFichier = "N80_PdM_global_V8.6.xlsx" 'Format du Nom : "XXXXX.xlsx"

Workbooks.Open Filename:=Chemin & NomFichier, ReadOnly:=True ' Ouverture du fichier data en lecture seule

'Importer la Data

Dim Base As String 'Base = Fichier Collègue
Dim Interface As String ' Interface = Fichier Moi

Base = "N80_PdM_global_V8.6.xlsx"
Interface = "Interface Maintenance FSW_V1"

'Copie des colonnes

Workbooks(Base).Worksheets("PdM").Range("A:A").Copy
Workbooks(Interface).Worksheets("DATA").Range("A1").PasteSpecial Paste:=xlPasteValues

Workbooks(Base).Worksheets("PdM").Range("K:K").Copy
Workbooks(Interface).Worksheets("DATA").Range("B1").PasteSpecial Paste:=xlPasteValues

Workbooks(Base).Worksheets("PdM").Range("O:O").Copy
Workbooks(Interface).Worksheets("DATA").Range("C1").PasteSpecial Paste:=xlPasteValues

Workbooks(Base).Worksheets("PdM").Range("S:S").Copy
Workbooks(Interface).Worksheets("DATA").Range("D1").PasteSpecial Paste:=xlPasteValues

Workbooks(Base).Worksheets("PdM").Range("W:W").Copy
Workbooks(Interface).Worksheets("DATA").Range("E1").PasteSpecial Paste:=xlPasteValues

End Sub

Je ne sais pas si j'ai été claire ^^'

Merci d'avance pour votre temps !

Sub OuvrirData()

Dim wsDest as worksheet, wsSource as worksheet
Dim Chemin$, NomFichier$, Base$, Interface$ 

Chemin = "M:\donnees\metiers\TEID\400-TEID1_Production_Engineering\050-ALM\08_FRACHEA Pierre-Adrien\Maintenance Moyens\FSW\" 'Format du chemin "XX\XX\XX\"
NomFichier = "N80_PdM_global_V8.6.xlsx" 'Format du Nom : "XXXXX.xlsx"

Workbooks.Open Filename:=Chemin & NomFichier, ReadOnly:=True ' Ouverture du fichier data en lecture seule
'Importer la Data

Set wsSource = Activeworkbook.Worksheets("PdM") 'Base = Fichier Collègue
Set wsDest = thisworkbook.Worksheets("DATA") 'Interface = Fichier Moi

'Copie des colonnes
with wsDest 'sur la feuille de destination
    for i = 1 to 5 'pour les colonnes 1 à 5
        NBL = Application.counta(wsSource.columns(i)) 'compte nombre de cellules de la colonne i de la source
        select case i
            case 1 'si colonne 1
                .cells(1, i).resize(NBL, 1).value = wsSource.columns(i).value 'colonne 1 retaillée prend valeurs colonne 1 source
            case else 'pour les autres colonnes
                .cells(1, i).resize(NBL, 1).value = wsSource.columns(3 + i * 4).value 'colonne i retaillée prend valeurs de la colonne (3 + i * 4) de la source
        end select
    next i
end with

End Sub

Edit : code d'origine

Bonjour 3GB,

Je test ton code est je reviens vers toi ;)

C'est d'un tout autre niveau je dois avouer ^^' Je vais essayer de tout comprendre !

Merci pour ton temps

Alors ça fonctionne ! Mais je ne sais pas pourquoi ^^' Je vais essayer de comprendre ton code et de me familiariser avec :)

Merci beaucoup !!

Edit : message supprimé...

Je suis content que ça marche ! J'ai cru voir une erreur (d'où mes éditions de messages) .

Voici ce que je propose plutôt :

Sub OuvrirData()

Dim wsDest as worksheet, wsSource as worksheet
Dim Chemin$, NomFichier$, Base$, Interface$ 

Chemin = "M:\donnees\metiers\TEID\400-TEID1_Production_Engineering\050-ALM\08_FRACHEA Pierre-Adrien\Maintenance Moyens\FSW\" 'Format du chemin "XX\XX\XX\"
NomFichier = "N80_PdM_global_V8.6.xlsx" 'Format du Nom : "XXXXX.xlsx"

Workbooks.Open Filename:=Chemin & NomFichier, ReadOnly:=True ' Ouverture du fichier data en lecture seule
'Importer la Data

Set wsSource = Activeworkbook.Worksheets("PdM") 'Base = Fichier Collègue
Set wsDest = thisworkbook.Worksheets("DATA") 'Interface = Fichier Moi

'Copie des colonnes
with wsDest 'sur la feuille de destination
    for i = 1 to 5 'pour les colonnes 1 à 5
        select case i
            case 1 'si colonne 1
                NBL = Application.counta(wsSource.columns(i)) 'compte nombre de cellules de la colonne i de la source
                .cells(1, i).resize(NBL, 1).value = wsSource.columns(i).value 'colonne 1 retaillée prend valeurs colonne 1 source
            case else 'pour les autres colonnes
                NBL = Application.counta(wsSource.columns(3 + i * 4)) 'compte nombre de cellules de la colonne (3 + i * 4) de la source
                .cells(1, i).resize(NBL, 1).value = wsSource.columns(3 + i * 4).value 'colonne i retaillée prend valeurs de la colonne (3 + i * 4) de la source
        end select
    next i
end with

End Sub

Maintenant, ça devrait prendre les bonnes valeurs car j'ai fait une petite inversion.

Le code ouvre le fichier de ton collègue (qui devient le classeur actif) tandis que ton fichier est l'exécutant (Thisworkbook).

Sur le fichier exécutant, le destinataire donc, les colonnes 1 à 5 prennent les valeurs des colonnes 1 ou (3 + i * 4) du fichier Base (c'est-à-dire 11, 15, 19, 23 quand i vaut resp. 2, 3, 4, 5). Tout ça grâce à une boucle et une récurrence identifiée à partir de la deuxième colonne à importer.

Re 3GB,

Petite question, si j'insert une nouvelle colonne (par exemple entre B et C) ma colonne "C" deviendra "D", la "D" deviendra "E", etc...

Donc si je copiais les valeurs de la colonne "C" comme ses valeurs ce sont déplacé en colonne "D" mon copier-coller ne sera plus bon.

Je ne sais pas si votre code résout ce problème ?

Non, tu insères une nouvelle colonne, les données seront toujours copiées aux mêmes emplacements (sur les 5 premières).

Il y a moyen de dire (puisqu'on a déjà un select case 1 ou autres) de coller en colonne i+1 de ton fichier quand i ne vaut pas 1.

Mais, à mon avis, le mieux serait de définir ta plage comme un tableau structuré (et si possible celle de ton collègue aussi) afin de coller les valeurs en fonction des titres de colonnes et non de leur index dans la feuille.

Moi, je peux définir ma plage comme un tableau structuré il n'y a aucun problème là-dessus, mais pour mon collègue ça sera plus compliqué (voir pas possible... Malheure...).

Le code change beaucoup si on travaille à partir des titres des colonnes ?

Merci encore pour votre réactivité !

Je t'en prie ! Quand tu auras nommé ton tableau, reviens vers moi pour me donner le nom du tableau et de ses colonnes et me dire où coller les valeurs et je modifierai le code.

A bientôt,

J'ai créer mon tableau.

Nom tableau : Tableaudata

Colonne A : Codification (trouve ses données en A)

Colonne B : EquipmentLevel1 (trouve ses données en K)

Colonne C : EquipmentLevel2 (trouveses données en O)

Colonne D : EquipmentLevel3 (trouveses données en S)

Colonne E : EquipmentLevel4 (trouve ses données en W)

Colonne F : EquipmentLevel5 (trouve ses données en AA

Colonne G : EquipmentLevel6 (trouve ses données en AE)

Colonne H : EquipmentDefinitionfile (trouve ses données en AM)

Colonne I : Additionaloperation (trouve ses données en BC)

Colonne J : Periodicity (trouve ses données en BD)

Colonne K : PeriodicityUnit (trouve ses données en BE)

Colonne L : Operationduration (trouve ses données en BG)

Dit moi si il te manque quelque chose :)

Bonsoir,

Avec le tableau nommé et les nouvelles colonnes à prendre en compte, voici le code à essayer :

Sub OuvrirData()

Dim wsDest as worksheet, wsSource as worksheet
Dim Chemin$, NomFichier$, Base$, Interface$ 

Chemin = "M:\donnees\metiers\TEID\400-TEID1_Production_Engineering\050-ALM\08_FRACHEA Pierre-Adrien\Maintenance Moyens\FSW\" 'Format du chemin "XX\XX\XX\"
NomFichier = "N80_PdM_global_V8.6.xlsx" 'Format du Nom : "XXXXX.xlsx"

Workbooks.Open Filename:=Chemin & NomFichier, ReadOnly:=True ' Ouverture du fichier data en lecture seule
'Importer la Data

Set wsSource = Activeworkbook.Worksheets("PdM") 'Base = Fichier Collègue
Set wsDest = thisworkbook.Worksheets("DATA") 'Interface = Fichier Moi

'Copie des colonnes
with wsDest 'sur la feuille de destination
    NBL = Application.counta(wsSource.columns(1)) 'compte nombre de cellules de la colonne i de la source
    .Range("Tableaudata[Codification]").resize(NBL, 1).value = wsSource.columns(1).value 'colonne 1 retaillée prend valeurs colonne 1 source
    for i = 2 to 7 'pour les colonnes 1 à 5
        NBL = Application.counta(wsSource.columns(3 + i * 4)) 'compte nombre de cellules de la colonne (3 + i * 4) de la source
        .Range("Tableaudata[EquipmentLevel" & i - 1 & "]").resize(NBL, 1).value = wsSource.columns(3 + i * 4).value 'colonne i retaillée prend valeurs de la colonne (3 + i * 4) de la source
    next i
    NBL = Application.counta(wsSource.columns(39)) 'compte nombre de cellules de la colonne 39 de la source
    .Range("Tableaudata[EquipmentDefinitionfile]").resize(NBL, 1).value = wsSource.columns(39).value 'colonne i retaillée prend valeurs de la colonne 39 de la source
    NBL = Application.max(Application.counta(wsSource.columns(55)), _
    Application.counta(wsSource.columns(56)), Application.counta(wsSource.columns(57))) 'compte max nombre de cellules entre colonnes 55 à 57 de la source
    .Range("Tableaudata[Additionaloperation:PeriodicityUnit]").resize(NBL, 3).value = wsSource.columns("BC:BE").value 'colonnes 9 à 11 retaillées prennent valeurs des colonnes 55 à 57 de la source
    NBL = Application.counta(wsSource.columns(59)) 'compte nombre de cellules de la colonne 59 de la source
    .Range("Tableaudata[Operationduration]").resize(NBL, 1).value = wsSource.columns(59).value 'colonne 12 retaillée prend valeurs de la colonne 59 de la source
end with

End Sub

C'est probablement améliorable mais ça devrait fonctionner.

Wowww ! Tu gères ! Merci beaucoup !!!
j’essaye ça demain matin et je te fais un retour :)

Dans tous les cas merci beaucoup pour ton aide et ta patience !

Je t'en prie, bonne nuit !

Bonjour 3GB,

j'ai un petit bug dans le programme que tu m'as créer ^^' oui je sais j'abuse un peu :)

Ci-dessous la ligne en question. Je cherche de mon coté !

Merci encore pour ton temps !!

Le message d'erreur si ça peut t'aider :

Il y a un bug parce que l'objet n'est pas reconnu donc fort probablement parce que le nom du tableau ou de la colonne en question est mal renseigné dans le code.

Il faut le remplacer dans le code par le bon nom (à coup de ctrl + F : remplacer : "lemauvaisnom" par "lebonnom").

D'ailleurs, plus les noms sont courts et simples, mieux c'est .

Attention cependant à laisser les numéros des colonnes Equipmentlevel car le code utilise cette numérotation.

Cdlt,

Super merci ! je me doutai que le nom en etait la cause !

Merci pour ta petite astuce ! :)

Bonjour 3GB !

J'ai besoin de ton expertise si tu veux bien :)

Je te présente mon code qui tourne depuis 3 mois maintenant. Or, la semaine dernière, je me suis aperçu que la totalité des colonnes du fichier DATA n'étaient pas "copier-coller" sur mon interface ...

Par exemple la colonne "A" qui comprend 3728 lignes s'arrête à la ligne 3727... mais ce qui est bizarre c'est que la colonne "C" qui comprend aussi 3728 lignes, s'arrête à la ligne 1802...

Je crains que le problème vienne du fichier Excel de mon collègue, mais je voudrai, si tu veux bien, que tu vérifies que mon code ne comporte pas d'erreur.

Mon code :

Sub OuvrirDatatest()

'Message de lancement ou non de la macro
If MsgBox("Avant de lancer le chargement des données, vérifier de bien être branché au réseau !   Sinon, cliquer sur 'Annuler'.  ", vbOKCancel + vbExclamation, "Chargement des données") = vbCancel Then
Exit Sub
End If

'Message d'information sur la durrée de traitement
If MsgBox("Le traitement des données peut prendre un moment merci de patienter", vbInformation, "Il est temps de prendre un café non ?") = vbOK Then
End If

'Définition des variables
Dim wsDest As Worksheet, wsSource As Worksheet, wsPart As Worksheet, wsConso As Worksheet
Dim Chemin$, NomFichier$, Base$, Interface$

'Format du chemin "XX\XX\XX\"
Chemin = "M:\donnees\metiers\TEID\400-TEID1_Production_Engineering\050-ALM\08_FRACHEA Pierre-Adrien\Maintenance\Projet PFE\"

'Format du Nom : "XXXXX.xlsx"
NomFichier = "N80_PdM_global_V9.4.xlsx"

'Ouverture du fichier data en lecture seule et annulation du message de mise à jour (messages d'erreurs)
Workbooks.Open Filename:=Chemin & NomFichier, ReadOnly:=True, UpdateLinks:=0

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

' TRAITEMENT Feuille DATA

Set wsSource = ActiveWorkbook.Worksheets("PdM") 'Data Base = PDM
Set wsDest = ThisWorkbook.Worksheets("DATA") 'Interface = Fichier Moi

'Copie des colonnes vers l'interface

    With wsDest 'sur la feuille de destination

        'Copie de la colonne "Codification" vers l'interface
        NBL = Application.CountA(wsSource.Range("Tableau1[Codification]"))
        .Range("Tableau3[Codification]").Resize(NBL, 1).Value = wsSource.Range("Tableau1[Codification]").Value

        'Copie des colonnes "Equipment Level" 1 à 6 vers l'interface
        .Range("Tableau3[Equipment Level 1]").Resize(NBL, 1).Value = wsSource.Range("Tableau1[Equipment   Level 1]").Value
        .Range("Tableau3[Equipment Level 2]").Resize(NBL, 1).Value = wsSource.Range("Tableau1[Equipment level 2]").Value
        .Range("Tableau3[Equipment Level 3]").Resize(NBL, 1).Value = wsSource.Range("Tableau1[Equipment level 3]").Value
        .Range("Tableau3[Equipment Level 4]").Resize(NBL, 1).Value = wsSource.Range("Tableau1[Equipment  Level 4]").Value
        .Range("Tableau3[Equipment Level 5]").Resize(NBL, 1).Value = wsSource.Range("Tableau1[Equipment level 5]").Value
        .Range("Tableau3[Equipment Level 6]").Resize(NBL, 1).Value = wsSource.Range("Tableau1[Equipment level 6]").Value

        'Copie de la colonne "Equipment Definition file reference 2" vers l'interface
        NBL = Application.CountA(wsSource.Range("Tableau1[Equipment Definition file reference 2]"))
        .Range("Tableau3[Equipment Definition file reference 2]").Resize(NBL, 1).Value = wsSource.Range("Tableau1[Equipment Definition file reference 2]").Value

        'Copie de la colonne "Rationale" vers l'interface
        NBL = Application.CountA(wsSource.Range("Tableau1[Rationale]"))
        .Range("Tableau3[Rationale]").Resize(NBL, 1).Value = wsSource.Range("Tableau1[Rationale]").Value

    End With

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

   'Fermeture du fichier Data
   Workbooks(NomFichier).Close False

End Sub

Merci d'avance pour ton aide et pour ton temps :)

Salut Pirateee,

Je me suis permis des petites libertés dans la façon de modifier (style, commentaires, ordre d'instructions et surtout façon de procéder).

Pour résumer, on teste l'existence du fichier avant tout. Si la connexion au réseau n'est pas établie, il y aura donc sortie de procédure sans bug (ça reste à confirmer) assortie d'un message.

J'ai créé 2 array permettant de lister les noms des colonnes d'origine et de destination pour simplifier. L'idéal serait d'en avoir un seul avec des noms de colonnes identiques. DONC il serait bien de supprimer tous les espaces indésirables sur les en-têtes de la source ! D'ailleurs, il serait préférable de renommer carrément ces en-têtes afin d'avoir des noms courts et simples.

En cas d'échec de l'ouverture du fichier (qui a priori serait dû au fait d'essayer d'ouvrir le fichier source déjà ouvert) on a une sortie avec message.

Sinon, c'est le grand changement (et j'attends de voir si ça va), on ne compte plus le nombre de valeurs, cause probable du problème en cas de cellules vides en milieu de colonne. On prend directement toutes les lignes (des colonnes ciblées bien entendu) du tableau source. Ces lignes viennent donc remplacer les lignes du tableau de destination. Normalement, les 2 tableaux sont de même hauteur... ?

Sub OuvrirDatatest()

Chemin = "M:\donnees\metiers\TEID\400-TEID1_Production_Engineering\050-ALM\08_FRACHEA Pierre-Adrien\Maintenance\Projet PFE\"
NomFichier = "N80_PdM_global_V9.4.xlsx"

if dir(Chemin & NomFichier) = "" then
    msgbox "Fichier introuvable !" & vblf & vblf & "Vérifiez la connexion au réseau.", vbcritical, "Procédure avortée"
    exit sub
end if

MsgBox "Le traitement des données peut prendre un moment merci de patienter", vbInformation, "Il est temps de prendre un café non ?"

tSource = array("Codification", "Equipment   Level 1", "Equipment level 2", "Equipment level 3", "Equipment  Level 4", "Equipment level 5", "Equipment level 6", "Equipment Definition file reference 2", "Rationale")
tDest = array("Codification", "Equipment Level 1", "Equipment Level 2", "Equipment Level 3", "Equipment Level 4","Equipment Level 5", "Equipment Level 6", "Equipment Definition file reference 2", "Rationale")
Set wsDest = ThisWorkbook.Worksheets("DATA") 'Interface = Fichier Moi

on error goto fin
with Workbooks.Open(Filename:=Chemin & NomFichier, ReadOnly:=True, UpdateLinks:=0)
    with .Worksheets("PdM") 'Data Base = PDM
        NBL = .Range("Tableau1").rows.count
        for i = lbound(tDest) to ubound(tDest)
            wsDest.Range("Tableau3[" & tDest(i) & "]").Resize(NBL, 1).Value = .Range("Tableau1[" & tSource(i) & "]").Value
        next i
    End With
    .Close False
end with

exit sub

fin:
msgbox "Vérifiez que le fichier n'est pas ouvert avant d'exécuter la macro", vbcritical, "Procédure avortée"

End Sub

C'est à voir. Si tu as des questions ou des précisions, n'hésite pas. Et je pense que tu devrais suivre mon conseil sur les noms de colonne !

A bientôt,