Option Explicit
Sub Listage()
'Microsoft Scripting Runtime requis
Dim Répertoire As String, Lig&, FSO As New FileSystemObject, Dossier As Folder, Fichier As File
Répertoire = ThisWorkbook.Path
Lig = 1
Cells.ClearContents
On Error Resume Next
Set Dossier = FSO.GetFolder(Répertoire)
If Err Then MsgBox "Accès au dossier """ & Répertoire & """ impossible.", vbCritical, "Recherche": Exit Sub
On Error GoTo 0
For Each Fichier In Dossier.Files
If Fichier.Name Like "*.*" Then
Lig = Lig + 1
Cells(Lig, 1) = Dossier.Name
Cells(Lig, 2) = Fichier.Name
End If
Next Fichier
Cells.Columns.AutoFit
End Sub