VBA - import colonnes correspondantes

Question

"Débrouillard" en VBA, je ne sais pas encore tout faire. En effet je ne parviens pas à avancer sur un code. Je possède deux fichiers: 1 fichier source contenant un grand tableau de données, et 1 autre fichier vide. Mon souhait est de pouvoir importer dans le fichier vide, les données du fichier source mais seulement celles correspondant aux intitulés de colonnes inscrit en ligne 1. Pour info, le nombre de lignes du fichier source varie tous les jours. Je ne sais pas j'ai été assez précis, mais l'exemple du résultat souhaité est en pj. Merci beaucoup...

ThauThème · Accepted Answer

Bonjour QDF, bonjour le forum,

Peut-être comme ça :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim DC As Byte 'déclare la variable DC (Dernière Colonne)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim R As Range 'déclare la variable R (Recherche)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Sheet1") 'définit l'onglet destination CD
CA = CD.Path & "\" 'définit le chemin d'accès CA
On Error Resume Next 'gestion des erreurs (en cas dérreur passe à la ligne suivante)
Set CS = Workbooks("source.xlsx") 'définit le classeur source CS (génère une erreur si ce classeur n'est pas ouvert)
If Err > 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Set CS = Workbooks.Open(CA & "source.xlsx") 'définit le classeur source CS en l'ouvrant (à condition qu'il soit dans la même dossier sinon ce code va planter)
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OS = CS.Worksheets("Sheet1") 'définit l'onglet source OS
OD.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface les anciennes valeurs
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet source OS
OS.Range("A10:A" & DL).Copy OD.Range("A2") 'copie la plage A10:A... de l'onglet source et la colle dans A2 de l'onglet destination
DC = OD.Cells(1, Application.Columns.Count).End(xlToLeft).Column 'définit la dernière colonne éditée de la ligne 1 de l'onglet destination OD
For COL = 2 To DC 'booucle sur toutes les colonnes COL de 2 à DC
    Set R = OS.Rows(8).Find(OD.Cells(1, COL), , xlValues, xlWhole) 'définit la recherche R (recherche la valeur exacte de la boucle dans la ligne 8 de l'onglet source)
    If Not R Is Nothing Then 's'il existe au moins une occurrence trouvée
        DL = OS.Cells(Application.Rows.Count, R.Column).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne de l'occurrence trouvée dans l'onglet source
        OS.Range(OS.Cells(10, R.Column), OS.Cells(DL, R.Column)).Copy OD.Cells(2, COL) 'copie la plage de l'onglet source et la colle dans la cellule ligne 2 colonne COL
    End If 'fin de la condition
Next COL 'prochaine colonne de la boucle
End Sub