Macro donnant le nom de mes fichiers excel à mes feuilles excel Fermé

Question

Bonjour, ma macro permet pour l'instant de prendre mes fichiers excel qui sont dans un dossier, et pour chaque fichiers, une feuille correspondante se créée. Je souhaiterais renommer chaque nouvelle feuille créée par le nom du fichier excel correspondant. Quelqu'un pourrait-il m'aider svp? :) 

Ci-dessous ma macro actuelle:

Sub Macro1()

' Touche de raccourci du clavier: Ctrl+m

Dim dossier As String
dossier = "F:\Excel\Dossier macro\Nouveau dossier\"
Fichier = Dir(dossier & "*.*")
ActiveWorkbook.Worksheets.Add

While Fichier <> ""
Debug.Print dossier & Fichier

    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & dossier & Fichier, Destination:=Range("$A1048576").End(xlUp).Offset(1, 0))
        .Name = Fichier
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 23
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
    Fichier = Dir
Wend
End Sub

f894009 · Answer

Bonjour,

 prendre mes fichiers excel Z'etes sure de votre fait, avec une connexion en text ???????????????

Sub Macro1()
    ' Touche de raccourci du clavier: Ctrl+m
    Dim dossier As String
    
    dossier = "F:\Excel\Dossier macro\Nouveau dossier\"
    Fichier = Dir(dossier & "*.*")
    While Fichier <> ""
        ActiveWorkbook.Worksheets.Add
        ActiveSheet.Name = Fichier
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & dossier & Fichier, Destination:=Range("$A1048576").End(xlUp).Offset(1, 0))
            .Name = Fichier
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 23
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = True
            .TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Fichier = Dir
    Wend
End Sub

Macro donnant le nom de mes fichiers excel à mes feuilles excel

1 réponse

Discussions similaires

Newsletters