Copier tout le code ci-dessous dans un module.
Dans une feuille vierge créer trois boutons.
Affecter au premier la macro "Appel", au deuxième la macro "RecupFichierTableau" au troisième la macro "Imprim".
La macro "Appel" ouvre un mini explorateur qui permet de sélectionner un répertoire, et inscrit ce répertoire dans la cellule A2.
La macro "RecupFichierTableau" affiche la liste des fichiers dans la plage "D2:Dxxx" et les tri par ordre alphabétique.
La macro "Imprim" comme son nom l'indique imprime la liste des fichiers.

Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Range("a2") = GetDirectory
Else
GetDirectory = ""
End If
End Function

'Appel a la procedure :

Sub appel()
Range("D2:D2000").ClearContents
Msg = "Selection de la directory desire"
ChDir GetDirectory(Msg)
End Sub

Sub RecupNomFichier(ByVal Chemin As String, ByRef Tableau As Variant)
Dim Fichier As String
Dim Compteur As Integer
Dim LigneCompteur As Integer
Chemin = Range("A2")
Chemin = Chemin + "\*.*"
Compteur = 1
Fichier = Dir(Chemin)
Do While (Len(Fichier) > 0)
ReDim Preserve Tableau(Compteur)
Tableau(Compteur - 1) = Fichier
LigneCompteur = Compteur + 1
ActiveSheet.Range("D" & LigneCompteur).Value = Tableau(Compteur - 1)
Compteur = Compteur + 1
Fichier = Dir()
Loop
End Sub

Sub RecupFichierTableau()
Application.ScreenUpdating = False
On Error Resume Next
Dim Tableau() As String
Call RecupNomFichier(Chemin, Tableau)
FiltreAlpha
End Sub

Sub Imprim()
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

Sub FiltreAlpha()
Columns("D:D").Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
With Selection
.HorizontalAlignment = xlGeneral
.Orientation = 0
End With
With Selection
.HorizontalAlignment = xlRight
.Orientation = 0
End With
Range("D1").Select
End Sub