Ajouter sur chaque ligne du fichier importer le NOM DU FICHIER

Bonjour le forum

J'ai cette Macro qui me permet d'importer un fichier .txt dans un classeur exel.

je cherche le moyen d'ajouter sur chaque ligne du fichier importer le NOM DU FICHIER.

Si j'importe le fichier 17-06-2020.txt je voudrais qu'il soit indiquer 17-06-2020.txt dans la colonne "J"

Sub Importer()

    Application.ScreenUpdating = False

    Set monWB = ActiveWorkbook
    ChDrive "S:"    ' Choix du lecteur
    ChDir "S:\SAUVEGARDE\SUIVI BADGE SYNCRONIQUE\EXTRACTION"
    w = Application.GetOpenFilename(, , , , True)
    For i = 1 To UBound(w)
        Workbooks.Open (w(i))
            Set wb = ActiveWorkbook
            For Each f In wb.Worksheets
                f.Cells.Copy
                monWB.Sheets.Add After:=monWB.Sheets(monWB.Sheets.Count)
                monWB.Activate
                On Error GoTo DéjàImporté
                ActiveSheet.Name = f.Name
                Range("A1").Select
                ActiveSheet.Paste
                Range("A1").Select
            Next f
        Application.CutCopyMode = False
        wb.Close False
    Next i
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp

    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("RECAP").Select
    Range("A65000").End(xlUp).Offset(1).Select
    ActiveSheet.Paste

Exit Sub

DéjàImporté:
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    wb.Activate
    MsgBox "Le nom de cette feuille exite déjà dans le fichier " & monWB.Name, 16

    Application.ScreenUpdating = True

End Sub

Merci de votre aide

Bonjour

En aveugle (par manque de fichier), ajoute cette troisième ligne

                ActiveSheet.Name = f.Name
                Range("A1").Select
                Range("J1:J" & Range("A" & Rows.Count).End(xlUp).Row) = w(i).Name

Bonjour Steelson

Merci de ton aide

re bonjour

quand je fait cela j'ai un message:" Le nom de cette feuille existe déja dans le fichier"

Alors que pour le test je l'ai supprimer.

et lorsque je supprime cette ligne :

Range("J2:J" & Range("A" & Rows.Count).End(xlUp).Row) = w(i).Name

ca fonctionne mais je n'est pas l'information dans la colonne J

Merci

reinruof77 a écrit :

quand je fait cela j'ai un message:" Le nom de cette feuille existe déja dans le fichier"

normalement c'est relatif à cette ligne

ActiveSheet.Name = f.Name

reinruof77 a écrit :

et lorsque je supprime cette ligne :

Range("J2:J" & Range("A" & Rows.Count).End(xlUp).Row) = w(i).Name

ca fonctionne mais je n'est pas l'information dans la colonne J

incompréhensible !

as-tu un fichier simplifié ? et quelques fichiers source simplifiés ?

re

je prepare cela au vu que ce sont des fichiers confidentiel.

Merci

Ta gestion d'erreur est un peu trompeuse car elle suppose que quelque soit l'erreur c'est dû au message que tu as mis !

Pour mettre au point il vaut mieux ne pas le faire tout de suite. L'erreur venait de w(i).Name.

Ceci fonctionne bien

Sub Importer()

    Application.ScreenUpdating = False

    Set monWB = ActiveWorkbook
    'ChDrive "S:"    ' Choix du lecteur
    ChDrive "C:"    ' Choix du lecteur
    'ChDir "S:\SAUVEGARDE\SUIVI BADGE SYNCRONIQUE\EXTRACTION"
    ChDir "C:\Users\Michel\Downloads"
    w = Application.GetOpenFilename(, , , , True)
    For i = 1 To UBound(w)
        Workbooks.Open (w(i))
            Set wb = ActiveWorkbook
            For Each f In wb.Worksheets
                f.Cells.Copy
                monWB.Sheets.Add After:=monWB.Sheets(monWB.Sheets.Count)
                monWB.Activate
                'On Error GoTo DéjàImporté
                ActiveSheet.Name = f.Name
                Range("A1").Select
                ActiveSheet.Paste
                Range("J1:J" & Range("A" & Rows.Count).End(xlUp).Row) = wb.Name
                Range("A1").Select
            Next f
        Application.CutCopyMode = False
        wb.Close False
    Next i
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp

End Sub

Pour ta gestion d'erreur (feuille déjà existante), j'aurais fait ceci

            Set wb = ActiveWorkbook
            For Each f In wb.Worksheets
                f.UsedRange.Copy
                Set ws = monWB.Sheets.Add(After:=monWB.Sheets(monWB.Sheets.Count))
                ws.Paste
                ws.Range("J1:J" & Range("A" & Rows.Count).End(xlUp).Row) = wb.Name
                On Error Resume Next
                    ws.Name = f.Name
                    If Err Then
                        Debug.Print "Erreur " & Err & ", suppression de la feuille !"
                        Application.DisplayAlerts = False
                        monWB.Sheets(ws.Name).Delete
                        Application.DisplayAlerts = True
                        ws.Name = f.Name
                    End If
                On Error GoTo 0
            Next f

ou alors tu mets aussi le nom du fichier dans le nom de l'onglet

Re bonjour

un seul mot a dire PARFAIT.

Merci encore.