re
voilà le code qui va chercher les fichiers du sous répertoire Données, les parties critère, tri et copier coller ne te concernent pas :
chemin = ThisWorkbook.Path & "\Données\"
nomfichier = ActiveWorkbook.Name
critère = "dupont"
'
Set fs = Application.FileSearch
With fs
.LookIn = chemin
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox "Ce dossier contient " & .FoundFiles.Count & _
" fichier(s) répondant aux critères."
For i = 1 To .FoundFiles.Count
fichierlu = .FoundFiles(i)
MsgBox .FoundFiles(i)
Workbooks.Open FileName:=fichierlu
fenêtrelue = ActiveWorkbook.Name
Range("a1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:=critère
' taille de la sélection à copier
Range("a65536").Select
Selection.End(xlUp).Select
If ActiveCell.Value <> 1 Then
dernière_ligne = ActiveCell.Row
Range("A2:E" & dernière_ligne).Select
Selection.Copy
Windows(nomfichier).Activate
'mettre à la suite
Range("a65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End If
Windows(fenêtrelue).Activate
' Selection.AutoFilter Field:=2
Application.CutCopyMode = False
Selection.AutoFilter
ActiveWindow.Close SaveChanges:=False
Windows(nomfichier).Activate
Range("A1").Select
Next i
Else
MsgBox "Aucun fichier n'a été trouvé."
End If
End With
si dans le répertoire tu as différents fichiers (xls et autres), il faudra sans doute adapter
A+
Eric