Ouvrir des fichiers dans un dossier dans l'ordre de création

Sub Nom de la macro()
Dim dossier As Object, Fichier As Object, Chemin As String, Lg As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = True
DerLg = Range("A2:F100000").End(xlUp).Row + 1
Range("A2:F100000").ClearContents
Chemin = "Le nom de mon chemin"
FName = Dir(Chemin & "\" & "*.xlsm")
Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
Lg = 2
For Each Fichier In dossier.Files
NomFichier = Fichier.Name
If Not Fichier.Name = "Le nom de mon fichier" Then
Workbooks.Open Filename:=Chemin & "/" & NomFichier
On Error Resume Next

With Workbooks(NomFichier)
ThisWorkbook.Sheets("Nom de la page dans le fichier").Range("A" & Lg) = .Sheets("Nom de la page dans le fichier").Range("Nom de la cellule").Value

ThisWorkbook.Sheets("Nom de la page dans le fichier").Range("B" & Lg) = .Sheets("Nom de la page dans le fichier").Range("Nom de la cellule").Value

ThisWorkbook.Sheets("Nom de la page dans le fichier").Range("C" & Lg) = .Sheets("Nom de la page dans le fichier").Range("Nom de la cellule").Value

ThisWorkbook.Sheets("Nom de la page dans le fichier").Range("E" & Lg) = .Sheets("Nom de la page dans le fichier").Range("Nom de la cellule").Value

ThisWorkbook.Sheets("Nom de la page dans le fichier").Range("F" & Lg) = .Sheets("Nom de la page dans le fichier").Range("Nom de la cellule").Value

.Close False
Lg = Lg + 1
End With
End If
Next

End Sub

Cliquez pour agrandir...