Ajouter le nom du fichier duquel les données ont été copiées

Bonsoir Forum,

SVP

Y a-t-il une ligne à ajouter à ce code afin d'ajouter le nom du fichier à partir duquel les données ont été copiées dans la colonne G Worksheets("Examen")

Merci infiniment

voici le code

Sub imprtdonnéesplusieursfichiers()

Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
'on Désactive le presse papier et la raffraich écran
Application.ScreenUpdating = False
  Application.CutCopyMode = False

  'effece anciennes données
  Range("B18:I100000").Value = ""

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Examen") 'définit l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(CA & "note*.xlsx?") 'définit le premier fichier excel F commençant par "export" ayant CA comme chemin d'accès
Do While F <> "" 'exécute tant qu'il existe des fichiers F
    If Not F = CD.Name Then 'si F est différent du nom du fichier destination
        Set CS = Workbooks.Open(CA & F) 'définit le classeur source CS en l'ouvrant
        Set OS = CS.Worksheets("NotesEX") 'définit l'onglet source OS
         'définit la cellule de destination DEST (c18 si B18 est vide sinon la première cellule vide de la colonne C de l'onglet OD)
        Set DEST = IIf(OD.Range("C18").Value = "", OD.Range("C18"), OD.Cells(Application.Rows.Count, "C").End(xlUp).Offset(1, 0))
        OS.Range("C18:F118").Copy DEST 'copie la plage C18:F118 de l'onglet source et le colle dans DEST
        CS.Close False 'ferme le classeur source sans enregistrer
         F = Dir 'définit le prochain fichier F commençant par "export" ayant CA comme chemin d'accès

    End If 'fin de la condition

Loop 'boucle
OD.Activate 'active l'onglet OD
Application.ScreenUpdating = True
  Application.CutCopyMode = True
End Sub

bonjour,
un essai : OS.Range("G1").value=CS.name ... ou CA & F

Bonjour Forum,

S'il vous plaît, comment puis-je modifier ce code car dans la colonne g où le nom du fichier est récupéré, il ajoute toujours 16 copies supplémentaires du dernier fichier, que le nombre de fichiers copiés soit un ou plusieurs

Je veux mettre le fichier mais son taille 2,60 MO

Merci infiniment

Sub information()
Dim wb As Workbook, lr1 As Integer, lr2 As Integer
Dim fil As Variant, dat As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lr1 = Sheets("Examen").Cells(Rows.Count, 2).End(xlUp).Row
 'Sheets("Examen").Range("C18:I" & lr1 + 1).ClearContents
 INF = ThisWorkbook.Path
fil = Dir(INF & "\*.xlsx")
Range("C18:I500").Value = ""

Do While fil <> ""
  If fil <> "fichier1.xlsm" Then
  Set wb = Workbooks.Open(INF & "\" & fil)

 lr1 = Workbooks("fichier1.xlsm").Sheets("Examen").Cells(Rows.Count, 3).End(xlUp).Row

 lr2 = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row

   ActiveSheet.Range("C18:F" & lr2).Copy Workbooks("fichier1.xlsm").Sheets("Examen").Range("C" & lr1 + 1)
 dep = Left(ActiveWorkbook.Name, Application.Search(".", ActiveWorkbook.Name) - 1)

  Workbooks("fichier1.xlsm").Sheets("Examen").Range("g" & lr1 + 1 & ":g" & lr1 + lr2 - 1) = dep

   ActiveWorkbook.Close
   fil = Dir
 End If
 Loop
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True