Bonjour à tous
Merci ERIC mais je ne sais vraiment pas où le placer. Je t'envoi le code
'Solution de papou, mpfe (code à adapter suivant besoin)
Sub lancer()
Dim noms_de_fichiers As Variant, I As Integer, y As Integer
Application.ScreenUpdating = False
ChDrive 'D' 'Modifie la lettre du lecteur
ChDir 'D:\\Clients' 'Modifie le répertoire
noms_de_fichiers = créer_liste_fichiers('*.xls')
Workbooks('teeest7.xls').Activate 'Modifie le nom du classeur
Sheets('Feuil2').Select 'Modifie le nom de la feuille
Range('A1', Range('A1').End(xlDown)).Select
Selection.ClearContents
Range('A1').Select
For I = 1 To UBound(noms_de_fichiers)
Cells(I, 1).Formula = noms_de_fichiers(I)
Next I
Dim currentcell, nextcell
Set currentcell = Worksheets('Feuil1').Range('A1') 'Modifie le nom de la feuille
Do While Not IsEmpty(currentcell)
Dim nom_fichier
Set nextcell = currentcell.Offset(1, 0)
nom_fichier = currentcell.Value
For y = 1 To ActiveWorkbook.Sheets.Count
'Dans la ligne ci-dessous modifie éventuellemnt les noms de classeur et de feuille
Next y
Set currentcell = nextcell
Loop
Application.ScreenUpdating = True
Worksheets('FEUIL1').Select
End Sub
Public Function créer_liste_fichiers(Filtre As String)
'===========================================================================
'Fonction permettant de générer une liste des fichiers présents dans le
'répertoire courant
'Cette liste va être générée dans la procédure Lancer
'===========================================================================
Dim listefichiers() As String, comptefichier As Long
créer_liste_fichiers = ''
Erase listefichiers
If Filtre = '' Then Filtre = '*.xls,es1'
With Application.FileSearch
.NewSearch
.LookIn = CurDir
.Filename = Filtre
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute(SortBy:=msoSortByFileName, _
sortorder:=msoSortOrderAscending) = 0 Then Exit Function
ReDim listefichiers(.FoundFiles.Count)
For comptefichier = 1 To .FoundFiles.Count
listefichiers(comptefichier) = .FoundFiles(comptefichier)
Next comptefichier
.FileType = msoFileTypeExcelWorkbooks
End With
créer_liste_fichiers = listefichiers
Erase listefichiers
End Function
Merci de ta patience
Manon