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

Salut 3GB !!

Merci pour ta réponse ! :) Je vais tester ton code !

Pour que les colonnes aient le même titre, il ne devrait pas y avoir de problème (je pensais l'avoir fais...^^' )

En revanche, pour renommer les colonnes sur le fichier source (DATA) ça va être plus compliqué... le fichier ne m'appartient pas vraiment... mais je vais faire mon possible !

Encore merci ! Je te fais un retour rapidement :)

C'est du pur GENIE !!! Ton code marche parfaitement :)

Donc maintenant, si je modifie les titres, pour que ceux de ma DATA et ceux de mon Interface soient les mêmes, comment ça se passe ?

Seconde question, pour insérer une nouvelle colonne à copier, je mets directement son titre dans le code ci-dessous ? :

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

Encore merci pour ton aide !

Ah c'est super ! Fais des essais quand même sans la connexion au réseau ou avec le fichier ouvert pour voir si on génère bien les messages et non des bugs...

Si les noms étaient identiques, on aurait alors un seul array et plus loin la boucle for un petit peu modifiée :

tCol = 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")

'poursuite du code

        for i = lbound(tCol) to ubound(tCol)
            wsDest.Range("Tableau3[" & tCol(i) & "]").Resize(NBL, 1).Value = .Range("Tableau1[" & tCol(i) & "]").Value
        next i
'suite et fin du code

C'est un petit gain , justement pratique si tu décides de copier d'autres colonnes.

Et si tu ajoutes une colonne, avec la première méthode, tu mets exactement le nom qu'elle a dans le Tableau1 de Source dans l'array tSource et le nom qu'elle a dans la Tableau3 de Pdm dans l'array tDest. Il faut juste respecter l'ordre. Chaque colonne doit correspondre au même item que sa colonne correspondante (Codification avec Codification, ....).

C'est pour ça que des noms identiques et un seul array rendent la tâche plus simple.

Super ! Merci beaucoup en tous cas

Je vais appliquer tes conseils et essayer de comprendre chaque partie de ton code pour pouvoir l'expliquer à mon tour :)

très bonne journée à toi

Très bien ! Et je n'ai pas commenté mais je peux le faire si besoin car j'ai conscience que le code est moins limpide que le précédent...

Merci, très bonne journée à toi aussi !

Non tkt pas pour les commentaires ! Je vais chercher ! ça me permet de mieux comprendre les subtilités du code et aussi d'augmenter mon LVL en VBA

bonjour, j'ai repris l'exemple très intéressant que j'ai essayé d'adapter à mon cas de figure. je suis débutant en vba. dans mon fichier de destination, feuille 'data', j'ai fait un tableau, tableau1 qui me permet de définir les entêtes de colonne que je souhaite récupérer. je les ai déclaré par Array. mes fichiers sources (une vingtaine fichier dans le même répertoire que mon fichier de destination, sont sur le feuil1 mais ne sont pas définit dans des tableaux.

je repris la macro que j'ai essayé d'adapter à mon usage. quand je la lance, j'ai toujours le message "Vérifiez que le fichier n'est pas ouvert avant d'exécuter la macro" et rien ne se passe (procédure avortée). je ne sais pas pourquoi ça me fait ça et je pense que c'est

wsDest.Range("Feuil1["
& tCol(i) & "]").Resize(NBL, 1).Value =
.Range("Tableau1[" & tCol(i) & "]").Value

ci joint le code repris et les deux fichiers d'exemple :
Sub Data()
Chemin = Application.GetOpenFilename("Fichiers Excels, *.xls*")'Chemin = "C:\Desktop\Nouveau dossier\"'NomFichier = "ADAMSNA.xlsx"
Dim Header_1, Header_2, Header_3    ', Header_4, Header_5, Header_6, Header_7, Header_8, Header_9, Header_10, Header_11
  'definit les noms des colonnes en dynamique Header_1 = Range("a1").Value Header_2 = Range("a2").Value Header_3 = Range("a3").Value'.....
If Dir(Chemin & NomFichier) = "" Then    MsgBox "Fichier introuvable !" & vbLf & vbLf & "Vérifiez la connexion au réseau.", vbCritical, "Procédure avortée"    Exit SubEnd 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(Header_1, Header_2, Header_3)'tDest = Array(Header_1, Header_2, Header_3)tCol = Array(Header_1, Header_2, Header_3)Set wsDest = ThisWorkbook.Worksheets("DATA") 'Interface = Fichier de destination (celui-ci)
On Error GoTo finWith Workbooks.Open(Filename:=Chemin & NomFichier, ReadOnly:=True, UpdateLinks:=0)    With .Worksheets("data") 'Data Base = PDM        NBL = .Range("Tableau1").Rows.Count        For i = LBound(tCol) To UBound(tCol)            wsDest.Range("Feuil1[" & tCol(i) & "]").Resize(NBL, 1).Value = .Range("Tableau1[" & tCol(i) & "]").Value        Next i    End With    .Close FalseEnd With

Exit Sub00-recap.xlsm

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

d'avance merci de votre aide

Denis

Bonjour trueblood,

Est-ce que tu peux reposter le code avec une indentation normale (j'ai l'impression qu'il a transité par un éditeur qui l'a rendu illisible).

A première vue, le bug survient parce que le fichier est ouvert quand tu exécutes la macro. Seul le fichier exécutant le code doit être ouvert au moment du lancement de la macro.

Cdlt,

re bonjour,ci joint le code :

Sub Data()

Chemin = Application.GetOpenFilename("Fichiers Excels, *.xls*")'Chemin = "C:\Desktop\Nouveau dossier\"'NomFichier = "ADAMSNA.xlsx"

Dim Header_1, Header_2, Header_3    ', Header_4, Header_5, Header_6, Header_7, Header_8, Header_9, Header_10, Header_11

  'definit les noms des colonnes en dynamique Header_1 = Range("a1").Value Header_2 = Range("a2").Value Header_3 = Range("a3").Value'.....

If Dir(Chemin & NomFichier) = "" Then    MsgBox "Fichier introuvable !" & vbLf & vbLf & "Vérifiez la connexion au réseau.", vbCritical, "Procédure avortée"    Exit SubEnd 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(Header_1, Header_2, Header_3)'tDest = Array(Header_1, Header_2, Header_3)tCol = Array(Header_1, Header_2, Header_3)Set wsDest = ThisWorkbook.Worksheets("DATA") 'Interface = Fichier de destination (celui-ci)

On Error GoTo finWith Workbooks.Open(Filename:=Chemin & NomFichier, ReadOnly:=True, UpdateLinks:=0)    With .Worksheets("data") 'Data Base = PDM     NBL = .Range("Tableau1").Rows.Count        For i = LBound(tCol) To UBound(tCol)            wsDest.Range("Feuil1[" & tCol(i) & "]").Resize(NBL, 1).Value = .Range("Tableau1[" & tCol(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

la macro ouvre le fichier source d'office

Bonjour 3BG,

voilà c'est mieux comme ça :P

comme je l'indiquais, la macro ouvre d'elle même le fichier source, donc il ne peut être qu'ouvert. mais j'ai peut être raté quelque chose dans les différents postes sur le sujet

Sub Data()

Chemin = Application.GetOpenFilename("Fichiers Excels, *.xls*")
'Chemin = "C:\Desktop\Nouveau dossier\"
'NomFichier = "ADAMSNA.xlsx"

Dim Header_1, Header_2, Header_3    ', Header_4, Header_5, Header_6, Header_7, Header_8, Header_9, Header_10, Header_11

  'definit les noms des colonnes en dynamique
 Header_1 = Range("a1").Value
 Header_2 = Range("a2").Value
 Header_3 = Range("a3").Value
'.....

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(Header_1, Header_2, Header_3)
'tDest = Array(Header_1, Header_2, Header_3)
tCol = Array(Header_1, Header_2, Header_3)
Set wsDest = ThisWorkbook.Worksheets("DATA") 'Interface = Fichier de destination (celui-ci)

On Error GoTo fin
With Workbooks.Open(Filename:=Chemin & NomFichier, ReadOnly:=True, UpdateLinks:=0)
    With .Worksheets("data") 'Data Base = PDM
        NBL = .Range("Tableau1").Rows.Count
        For i = LBound(tCol) To UBound(tCol)
            wsDest.Range("Feuil1[" & tCol(i) & "]").Resize(NBL, 1).Value = .Range("Tableau1[" & tCol(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

Bonjour trueblood,

Oui, c'est nettement mieux comme ça !

Que se passe-t-il alors ? As-tu essayé d'exécuter au pas à pas la macro ?

Voici un code à essayer pour identifier la cause du problème. Je ne pense pas qu'elle soit liée à l'ouverture mais à l'existence d'une des références dans le fichier source (il faut scrupuleusement respecter l'orthographe des noms du fichier de destination).

J'ai mis des commentaires pour que tu voies les points importants :

Sub Data()

Chemin = Application.GetOpenFilename("Fichiers Excels, *.xls*")
if Chemin = false then msgbox "Aucun fichier sélectionné", 16: exit sub

'------------------------------------------------
'-----POUR 11 ENTETES, ON PEUT FAIRE PLUS SIMPLE
'dim theader(1 to 11)
'for i = 1 to 11
'    theader(i) = range("A" & i).value
'next i
'------------------------------------------------
Dim Header_1, Header_2, Header_3    ', Header_4, Header_5, Header_6, Header_7, Header_8, Header_9, Header_10, Header_11

  'definit les noms des colonnes en dynamique
 Header_1 = Range("a1").Value
 Header_2 = Range("a2").Value
 Header_3 = Range("a3").Value
'.....

tCol = Array(Header_1, Header_2, Header_3) '<<< voir theader plus haut
Set wsDest = ThisWorkbook.Worksheets("DATA") 'Interface = Fichier de destination (celui-ci)

With Workbooks.Open(Filename:=Chemin & NomFichier, ReadOnly:=True, UpdateLinks:=0)
    With .Worksheets("data") '<<< CETTE FEUILLE EXISTE-T-ELLE SUR LE FICHIER SOURCE ???
        NBL = .Range("Tableau1").Rows.Count '<<< CE TABLEAU EXISTE-T-IL SUR LE FICHIER SOURCE ???
        For i = LBound(tCol) To UBound(tCol) 'pour chaque nom d'en-têtes
            wsDest.Range("Feuil1[" & tCol(i) & "]").Resize(NBL, 1).Value = .Range("Tableau1[" & tCol(i) & "]").Value
            '<<< LE TABLEAU "Feuil1" EXISTE-T-IL SUR LE FICHIER DESTINATION (EXECUTANT) ??? IL FAUT DES NOMS EVOCATEURS;
            'LES NOMS DE COLONNES DE tcol EXISTENT-ILS DANS LE TABLEAU STRUCTURE DU FICHIER SOURCE ???
        Next i
    End With
    .Close False
End With

End Sub

Sinon, tu peux m'expliquer ce que tu cherches à faire (car je vois des feuilles DATA, data, Feuil1 ?).

Cdlt,

Merci 3GB pour votre retour,

avec vos commentaires, je vois où et pourquoi ça bloque, par contre je ne suis pas certain de pouvoir solutionner le problème. Dans mon code, j’ai indiqué un tableau sur le fichier source qui n’existe pas, et une data qui est sur le fichier de destination mais pas sur les fichiers source (elle s’appelle toujours feuil1)

Mon besoin :

J’ai un fichier 00_recap (mon fichier de destination), sur lequel tous les mois j’importe une vingtaine de fichier source (voir plus), jusqu’à présent j’utilisai une macro « simple », pour faire un copié/collé automatique de tous les fichiers (feuil1) avec tout le contenu, puis je passais du temps à retravailler mon fichier de destination pour ne garder que ce qui m’intéresse.

Sub Compilation()
Dim Temp As String
Dim ligne As Long
Temp = Dir(ActiveWorkbook.Path & "\*.xlsx")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "00_Recap.xlsm" Then
Workbooks.Open ActiveWorkbook.Path & "\" & Temp
Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy
Workbooks("00_Recap.xlsm").Sheets(1).Activate
ligne = Sheets(1).Range("C" & Rows.Count).End(xlUp).Row + 1
Range("A" & CStr(ligne)).Select
ActiveSheet.Paste
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

Option Explicit

Quand j’ai vu le post de Pirateeee10, j’ai compris que je pouvais récupérer que ce dont j’ai besoin.

Donc ce que j’aimerai faire c’est définir les champs qui m’intéressent dans le fichier de destination (nom identique à tous les fichiers), et importer uniquement les données de ces champs-là. Dans mon fichier destination (00_recap), j’ai définit un tableau pour mettre les données dedans, mais dans les fichiers source aucun tableau n’est défini (et ne peut être défini).

La cerise sur le gâteau serait que dans mon fichier de destination en plus des champs que je souhaite récupérer, j’ai une colonne supplémentaire, m’indiquant le nom du fichier source, "provenance" :

je vais déjà corriger mes erreurs et essayer de faire fonctionner (mais je sens que la notion de non tableau dans les fichiers source va poser problème)

Oui, c'est ce que j'ai pensé quand j'ai vu "Feuil1"^^.

Je crois que j'ai compris.

Est-ce que les en-têtes des fichiers source sont toujours en ligne 1 ? En tout cas, ce sont toujours les mêmes ? Celles à récupérer correspondent aux en-têtes du tableau structuré du fichier de destination ? Il faut que les libellés d'en-têtes soient identiques strictement !

Oui, pour avoir le nom de la feuille de provenance, c'est faisable...

Sur les fichiers sources elles sont quasi toujours en ligne 1 (ça arrive que ça ne le soit pas de temps en temps, sur 1 ou 2 fichiers).

Le libellé du champs quand à lui, est toujours le même et identique au fichier destination qui est structuré.

Salut trueblood,

Voici un premier essai de code adapté à ta macro compilation qui sondera les fichiers xlsx du répertoire du classeur de destination et qui exécutera la macro Importer. Celle-ci ouvrira les fichiers, recherchera sur la feuille "Feuil1" les noms d'en-têtes et "copiera" les valeurs de la colonne correspondante dans la colonne du même nom du tableau "Tableau1" de la feuille "DATA" du fichier de destination avant de fermer le fichier :

Sub Compilation()
Dim sfilename As String, theader
with thisworkbook 'classeur exécutant (destination)
    theader = application.transpose(.Worksheets("DATA").range("A1:A11").value) 'tableau avec noms en-têtes alimenté par A1:A11 de "DATA"
    sfilename = Dir(.Path & "\*.xlsx") '1ere entrée répertoire avec filtre sur xlsx (pour boucle sur fichiers source)
    Do While sfilename <> "" 'si correspondance trouvée
        If sfilename <> .name Then 'si nom fichier <> nom classeur exec.
            'Appelle macro Importer (arguments : chemin complet fichier source, feuille dest, liste entêtes)
            Importer .path & "\" & sfilename, .Worksheets("DATA"), theader
        End If
        sfilename = Dir 'suivant
    Loop
end with
End Sub

Sub Importer(strFichierSource$, wsDest as worksheet, theader)
dim r as range, NBL&, nvl&, i&
nvl = wsDest.Range("Tableau1").rows.count + 1 'nouvelle ligne dans tableau
Application.DisplayAlerts = False
With Workbooks.Open(strFichierSource, 0, true) 'avec fichier source ouvert à l'instant
    With .Worksheets("Feuil1") 'avec "Feuil1"
        NBL = .usedrange.Rows.Count - 1 'nb de lignes des colonnes
        For i = LBound(theader) To UBound(theader) 'pour chaque nom d'en-tête
            set r = .cells.find(theader(i)) 'r est la cellule obtenue suite à la recherche de l'entete en cours
            wsDest.Range("Tableau1[" & theader(i) & "]").cells(nvl).Resize(NBL).Value = r.offset(1, 0).resize(NBL).Value
        Next i
    End With
    'wsDest.range("Tableau1[Provenance]").cells(nvl).resize(NBL).value = .name '<<< A ADAPTER nom colonne PROVENANCE pour récupérer nom source
    .Close False
End With
Application.DisplayAlerts = True
End Sub

Il faut bien s'assurer que :

- la feuille de destination est nommée exactement "DATA" ;

- son tableau structuré est nommé "Tableau1" ;

- que les noms des champs figurent bien en A1:A11 de cette feuille de destination ;

- qu'ils sont trouvables sur les fichiers source (identiques) ;

- que les feuilles source sont toutes libellées "Feuil1" ;

Cdlt,

Bonjour 3GB,

merci pour ta réponse et dsl pour la réponse tardive, je n'étais pas connecté avant. j'aurai une question par rapport au code, si je comprends bien je définis mes entêtes de colonne de la ligne 1 à 11 de la colonne A (faut il aussi les redéfinir dans les colonne ?):

user / date / nombre / provenance

date

nombre

ce n'est pas possible de partir sur les colonnes directement, j'ai essayé de le A11 par D1 (ou plus ou moins ?).

je n'ai pas de message d'erreur mais simplement un blocage sur la ligne de code.

Set r = .Cells.Find(theader(i)) 'r est la cellule obtenue suite à la recherche de l'entete en cours

lorsque j'essaye avec plus de 2 colonnes (et lignes) définit, la macro s'exécute mais ne prend que maxi 2 champs.

y a t'il un ordre des colonnes, par exemple je définis la colonne nombre avant date et dans le fichier source la colonne date apparaît avant ?

encore merci pour ta réponse

Bonjour trueblood,

Je n'ai pas bien compris mais ce doit être possible si le cadre est suffisamment bien défini et suit une logique reproductible par du code.

Pour A1:A11, je me suis basé sur ce que j'ai compris de ton code de départ.

Avec ce code, l'ordre des colonnes n'importe pas. Ce qui compte, c'est le nom ! Il faut :

- que les noms des colonnes du tableau de destination soient exactement identiques avec les noms des champs (forcément présents donc) des feuilles source,

- de préférence que ces noms de champ n'apparaissent qu'une fois.

Ce que tu as rencontré est un bug je pense, bien qu'il n'y ait pas de message directement. Il faut déboger et appuyer sur F5 pour voir le message. Il est certainement dû à un défaut de correspondance du nom de colonne dans le fichier source.

Bonjour 3GB,

oui effectivement dans mon "approche" de code, comme je ne voyais pas comment faire autrement, j'avais définit sur la colonne A1,A2,A3... pour les champs que je voulais récupérer. là avec le tableau Structuré (tableau1), les champs sont en ligne 1 : A1,B1,C1... jusqu'à Provenance. et je pense que c'est mieux de les utiliser directement, car si je veux récupérer 4 colonnes il faudra que je définisse 4 colonnes dans le tableau.

quand je rajoute des champs complémentaires (copier coller du fichier source pour avoir exactement les mêmes champs), la macro ne me ramène pas tous les champs : si j'en définit 3, ça m'en ramène que 2, si j'en définit 5, j'en récupère que 3...

le message en déboguant est

erreur d'exécution '1004' :

la méthode 'Range' de l'objet '_worksheet' a échoué

ça semble être effectivement les champs (mais je ne comprends pas trop pourquoi). ça peut être lié au format (gras, centré..) ? si tu as une idée je suis preneux

Salut trueblood,

D'accord, alors pour prendre directement les noms des champs du Tableau1 (ce qui est plus logique), sans prendre la dernière colonne (Provenance), il faut modifier l'alimentation de theader ainsi :

with .Worksheets("DATA").range("Tableau1")
    theader = application.transpose(application.transpose(.rows(0).resize(1, .columns.count - 1)))
end with

Sinon, je pense que les champs des fichiers source ne correspondent pas parfaitement. Il faut vérifier les espaces (de fin et de début) et les accents notamment.

Cdlt,