Récupérer les noms des fichiers présents dans un dossier

Fermé
Fabrice - 27 juil. 2020 à 15:07
 Fabrice - 27 juil. 2020 à 17:04
Bonjour,

J'ai crée un premier script dont l'objectif est de récupérer les éléments présents dans un dossier.
Option Explicit

Sub BoucleFichiers()
    Dim Chemin As String, Fichier As String
 
    'Définit le répertoire contenant les fichiers
    Chemin = "C:\Usersfolder\"
 
    'Boucle sur tous les fichiers xls du répertoire.
    'Fichier = Dir(Chemin & "*.xls")
    
    Fichier = Dir(Chemin & "*.*")
 
    Do While Len(Fichier) > 0
        MsgBox (Chemin & Fichier)
        Fichier = Dir()
    Loop
End Sub





Jusque là tout va bien avec ce script.
Maintenant, j'aimerais créer un onglet pour chaque fichier présent dans le dossier. Sachant que chaque fichier commence de la même façon (exemple : classe1Apremière, classeB2seconde, etc..)
Donc dans un fichier excel après l'execution de la macro, j'aurais un premier onglet 1A, un second B2, etc...

Merci d'avance pour votre aide.


Configuration: Windows / Chrome 80.0.3987.132
A voir également:

2 réponses

cs_Le Pivert
Messages postés
7784
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
24 juin 2022
711
27 juil. 2020 à 15:44
Bonjour,

Mettre le classeur avec cette macro dans le même dossier que les classeurs à rechercher

Sub lister()
Dim monFichier As String
Dim wb As Workbook
Dim chemin As String
Set wb = Workbooks(ThisWorkbook.Name) 'classeur reception
' On a besoin du chemin absolu du dossier
' Doit se terminer par \
chemin = ThisWorkbook.Path & "\"
' La fonction Dir(chemin, mode) permet de parcourir un dossier
' Ici je rajoute à mon chemin "*.xlsx",
' pour ne retrouver que mes fichiers Excel
' vbNormal permet de ne récupérer que des fichiers,
' vbDirectory récupère tout (dossiers et fichiers)
monFichier = Dir(chemin & "*.xlsx", vbNormal)
Do While monFichier <> ""
   wb.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Split(monFichier, ".")(0) 'ajoute un onglet et le renomme
' Permet de passer au fichier suivant
monFichier = Dir
Loop
End Sub

1