Sub CopierFichiers()
Dim t, chemin$, W As Worksheet, feuil$, ligdeb&, lig&
Dim dercol%, fichier$, F As Worksheet, dercel As Range, h&
t = Timer 'mesure facultative
'---initialisation---
chemin = ThisWorkbook.Path & "\"
Set W = Feuil1 'CodeName de la feuille de restitution
feuil = "BASE GLOBALE" 'nom à adapter
ligdeb = 3 '1ère ligne à copier
lig = ligdeb '1ère ligne restituée
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
W.Rows(ligdeb & ":" & W.Rows.Count).Delete 'RAZ
dercol = W.UsedRange.Columns.Count + 1 'pour les noms des fichiers
'---copie des fichiers---
fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
While fichier <> ""
If fichier <> ThisWorkbook.Name Then
Set F = Workbooks.Open(chemin & fichier).Sheets(feuil) 'ouverture du fichier
Set dercel = F.Cells.Find("*", , xlValues, , xlByRows, xlPrevious)
h = 1
If Not dercel Is Nothing Then
If dercel.Row >= ligdeb Then
h = dercel.Row - ligdeb + 1
F.Rows(ligdeb).Resize(h).Copy
W.Cells(lig, 1).PasteSpecial xlPasteValues 'valeurs
'W.Cells(lig, 1).PasteSpecial xlPasteFormats 'formats
End If
End If
W.Cells(lig, dercol).Resize(h) = fichier
F.Parent.Close False 'fermeture du fichier
lig = lig + h
End If
fichier = Dir 'fichier suivant du dossier
Wend
Application.Goto W.[A1], True
Application.ScreenUpdating = True
MsgBox "Durée " & Format(Timer - t, "0.00 \s") 'mesure facultative
End Sub