Aide VBA copier - coller des cellules spécifiques sur un autre fichier

Question

Je vous sollicite car je suis face à une impasse. Voici le problème : J'aimerais un code VBA qui doit ouvrir un classeur avec par exemple 4 feuilles avec des données , (ces données possédant chacune des entêtes , comme par exemple : nom et date) Que la macro serait capable de savoir lorsqu’il s’agit d’un nom et d’une date, et que lorsque c’est un nom, il copierait la colonne entière dans un fichier cible et idem pour la date, lorsque l'entête indique "date", il passerait à la ligne suivante et ensuite copierait l'intégralité de la colonne dans un autre fichier cible à l'emplacement "date". Et qu'ensuite, il marquerait que le fichier a été traité. Voilà ce que j'ai fait : Option Explicit Sub TransferDataV2() 'transfert de données Dim strPath2 As String Dim wbkWorkbook1 As Workbook Dim wbkWorkbook2 As Workbook 'définir les noms strPath2 = "Classeur3.xlsx" 'ouvrir les dossiers Set wbkWorkbook1 = ThisWorkbook '#changer Set wbkWorkbook2 = Workbooks.Open(strPath2) '#copier les valeurs '#changer la feuille et ranger ce dont j’ai besoin wbkWorkbook2.Worksheets("Feuil1").Range("A1:B4").Value = _ wbkWorkbook1.Worksheets("Feuil1").Range("A1:B4").Value 'fermeture du fichier wbkWorkbook2.Close (True) End Sub Il manque pas mal d'étapes, mais c'est ce que j'ai réussi à faire pour l'instant. Voici le fichier que j'essaye de copier pour l'instant ...

ThauThème · Accepted Answer

Bonjour Shayou, bonjour le forum,

Pas sûr d'avoir bien compris tes explications... Une proposition à placer dans le fichier destination (Celui qui reçoit les données ) :

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 O As Worksheet 'déclare la variable O (Onglet)
Dim TD As ListObject 'déclare la variable TD (Tableau structuré Destination)
Dim TS As ListObject 'déclare la variable TS (Tableau structuré Source)
Dim EF As FileDialog 'déclare la variable EF (Explorateur de Fichiers)
Dim LR As Integer 'déclare la variable LR (Ligne de Référence)
Dim CR As Integer 'déclare la variable CR (Colonne de Référence)
Dim RN As Range 'déclare la variable RN (Recherche de Nom)
Dim RD As Range 'déclare la variable RD (Recherche de Date)
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI (LIgne)

Set CD = ThisWorkbook 'définit la classeur Destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet Destination  OD (ici le premier, à adapter à ton cas)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set TD = OD.ListObjects("TResult") 'définit le tableau destination TD (génère ue erreur si "TResult" n'existe pas)
If Err > 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    OD.Range("A1").Value = "Nom" 'Nom en A1 de l'onglet OD
    OD.Range("B1").Value = "Date" 'Date en B1 de l'onglet OD
    OD.ListObjects.Add(xlSrcRange, Range("$A$1:$B$2"), , xlYes).Name = "TRésult" 'crée un tableau structuré nommé "TResult"
    Set TD = OD.ListObjects("Tableau1") 'définit le tableau structuré destination TD
End If 'fin de la condition
TD.DataBodyRange.Delete 'efface les anciennes valeurs de TD
On Error GoTo 0 'annule la gestion des erreur
Set EF = Application.FileDialog(msoFileDialogFilePicker) 'définit l'explorateur de fichier EF
EF.AllowMultiSelect = False 'n'autorise la sélection que d'un seul fichier
EF.Show 'affiche
If EF.SelectedItems.Count > 0 Then Set CS = Workbooks.Open(EF.SelectedItems(1)) 'si un fichier est sélectionné, définit le classeur source CS en l'ouvrant

For Each O In CS.Sheets 'boucle sur tous les onglets O du classeur source
    Set TS = O.ListObjects(1) 'définit le tableau structuré source TS de l'onglet de la boucle
    LR = TS.HeaderRowRange(1, 1).Row 'définit la ligne de référence LR
    CR = TS.HeaderRowRange(1, 1).Column 'définit la colonne de référence CR
    Set RN = O.Rows(LR).Find("Nom", , xlValues, xlWhole) 'définit la recherche RN (Recherche "Nom" dans la ligne de référence LR de l'onglet O)
    If Not RN Is Nothing Then 'condition 1 : s'il existe à moins une occurrence trouvée
        TD.Resize TD.Range.Resize(TD.ListRows.Count + TS.ListRows.Count, TD.ListColumns.Count) 'redimensionne TD
        Set R = TD.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de TD)
        If R Is Nothing Or TS.ListRows.Count = 0 Then 'condition 2 : si aucune occurrence trouvée ou si TD ne contient aucune ligne
            TD.ListRows.Add 'ajoute une ligne à TD
            LI = TD.ListRows.Count 'définit la ligne LI (dernière ligne de TD)
        Else 'sinon (au moins une occurrence trouvée)
            LI = R.Row - TD.HeaderRowRange.Row 'définit la ligne LI (ligne de la première occurrence trouvée moins la ligne des en-têtes de TD)
        End If 'fin de la condition 2
        'copie la colonne  de RN (sans l'en-tête) et la colle dans les données de TD ligne LI, colonne 1
        TS.DataBodyRange.Columns(RN.Column - CR + 1).Copy TD.DataBodyRange(LI, 1)
    End If 'fin de la condition 1
    Set RD = O.Rows(LR).Find("Date", , xlValues, xlWhole) 'définit la recherche RN (Recherche "Date" dans la ligne de référence LR de l'onglet O)
    If Not RD Is Nothing Then 'condition 3 : s'il existe au moins une occurrence trouvée
        'copie la colonne  de RD (sans l'en-tête) et la colle dans les données de TD ligne LI, colonne 2
        TS.DataBodyRange.Columns(RD.Column - CR + 1).Copy TD.DataBodyRange(LI, 2)
    End If 'fin de la condition 3
Next O 'prochain onglet de la boucle
CS.Close False 'ferme le classeur source sans enregistrer
End Sub

ThauThème · Answer

Bonjour Shayou, bonjour le forum,

Peux-tu envoyer une fichier exemple avec le problème avant dans un onglet et le résultat souhaité après dans un autre. Car je ne sais pas si tu veux les noms et les dates dans le même fichier comme dans ma première proposition...