Excel VBA intégrer dans une colonne le nom des fichiers source copié

Bonjour à tous et à toutes,

Dans un tableau récapitulatif (OIL EDU), à chaque lignes extraites d'un de mes nombreux fichiers , je souhaiterai y indiquer le nom du fichiers source en .xlsm, dans une colonne dédiée "Y" et ceci à partir de "Y8"

Au cas ou, mon code :

Sub CopierOIL()

'Adresse du Fichier source (C:\Users\brenaud\Desktop\EDU CAB TEST\DR EDU CAB)

'Nom des fichiers source (.xlsm)

'Nom de l'onglet source (OIL)

'Adresse du Fichier cible (C:\Users\brenaud\Desktop\EDU CAB TEST)

'Nom du fichier cible (00_ENG-RS-VPF-FRM-0XX_A_OIL EDU-CAB_DR3D_FTA_BDI.xlsm)

'Nom de l'onglet cible (OIL EDU)

Range("A8").Select 'sélectionner la cellule de début

Chemin = "C:\Users\brenaud\Desktop\EDU CAB TEST\DR EDU CAB\" 'Indiquer ici le chemin complet du dossier où se trouvent les fichiers

Fichier = Dir(Chemin & "*.xlsm") ' Premier fichier

Do While Fichier <> ""

Workbooks.Open Filename:=Chemin & Fichier

Range("'OIL'!$A$8:$X$38").Copy 'ici nommer la plage de la feuille à copier

ThisWorkbook.Activate

ActiveSheet.Paste

Windows(Fichier).Activate

Application.CutCopyMode = False

ActiveWorkbook.Close savechanges:=False

ThisWorkbook.Activate

Range("A65536").End(xlUp).Offset(1, 0).Select

Fichier = Dir ' Fichier suivant

Loop

End Sub

Merci à vous pour votre aide

Bonjour,

une proposition

Sub CopierOIL()

    'Adresse du Fichier source (C:\Users\brenaud\Desktop\EDU CAB TEST\DR EDU CAB)
    'Nom des fichiers source (.xlsm)
    'Nom de l'onglet source (OIL)
    'Adresse du Fichier cible (C:\Users\brenaud\Desktop\EDU CAB TEST)
    'Nom du fichier cible (00_ENG-RS-VPF-FRM-0XX_A_OIL EDU-CAB_DR3D_FTA_BDI.xlsm)
    'Nom de l'onglet cible (OIL EDU)

    ligne = 8
    Set ws = ThisWorkbook.ActiveSheet
    chemin = "C:\Users\brenaud\Desktop\EDU CAB TEST\DR EDU CAB\" 'Indiquer ici le chemin complet du dossier où se trouvent les fichiers
    fichier = Dir(chemin & "*.xlsm") ' Premier fichier
    Do While fichier <> ""
        Set wb = Workbooks.Open(Filename:=chemin & fichier)
        Set wss = wb.Sheets("OIL")
        wss.Range("$A$8:$X$38").Copy ws.Cells(ligne, 1)
        ws.Cells(ligne, "Y").Resize(31, 1) = fichier
        wb.Close False
        Application.CutCopyMode = False
        ligne = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
        fichier = Dir ' Fichier suivant
    Loop
End Sub

Bonjour H2so4,

Cool Un grand merci pour ta réponse ca marche assez bien

Par contre, un petit souci :

Lorsqu'il copie le nom du fichier source en question, il indique également le nom de ce fichier source sur les lignes vides qu'il y avait

Ce nom de fichier est ensuite écrasé lorsque le nouveau fichier est copié, … et ainsi de suite, et ceci jusqu'au dernier fichier source ou il reste du coup (pour mon cas) environ 25 lignes vides avec le nom de ce dernier fichier

Tu as une solution ?

Merci à toi

Bonsoir,

Sub CopierOIL()

    'Adresse du Fichier source (C:\Users\brenaud\Desktop\EDU CAB TEST\DR EDU CAB)
    'Nom des fichiers source (.xlsm)
    'Nom de l'onglet source (OIL)
    'Adresse du Fichier cible (C:\Users\brenaud\Desktop\EDU CAB TEST)
    'Nom du fichier cible (00_ENG-RS-VPF-FRM-0XX_A_OIL EDU-CAB_DR3D_FTA_BDI.xlsm)
    'Nom de l'onglet cible (OIL EDU)

    ligne = 8
    Set ws = ThisWorkbook.ActiveSheet
    chemin = "C:\Users\brenaud\Desktop\EDU CAB TEST\DR EDU CAB\" 'Indiquer ici le chemin complet du dossier où se trouvent les fichiers
    fichier = Dir(chemin & "*.xlsm") ' Premier fichier
    Do While fichier <> ""
        Set wb = Workbooks.Open(Filename:=chemin & fichier)
        Set wss = wb.Sheets("OIL")
        dl = wss.Cells(Rows.Count, 1).End(xlUp).Row
        wss.Range("$A$8:$X$" & dl).Copy ws.Cells(ligne, 1)
        ws.Cells(ligne, "Y").Resize(dl - 7, 1) = fichier
        wb.Close False
        Application.CutCopyMode = False
        ligne = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
        fichier = Dir ' Fichier suivant
    Loop
End Sub

Trop top ^^ un grand merci à toi H2so4

Du coup, c'est aussi plus fluide avec cette modification

Je débute sur VBA et certains rouages , même simples, ne me sont pas très familier, mais j'essaye

Un grand merci pour le temps que tu m'as accordé et un grand merci pour les personnes que tu aides également

Mon sujet est Résolu , trop cool ^^