Sub BoucleDeTraitement1() ' la boucle de traitement des fichiers
Dim ws As Worksheet, wbDest As Workbook, wbSource As Workbook
Dim Rep$, wbSynt$, fSource$, nFeuille$
Application.ScreenUpdating = False
Rep = "C:\Users\Fiche collectées\" 'Dossier
wbSynt = "Test12345.xls" 'fichier de synthèse
If Dir(Rep & wbSynt) <> "" Then 'test si wbSynt existe
Set wbDest = Workbooks.Open(Rep & wbSynt) 'l'ouvre si oui
Else
Set wbDest = Workbooks.Add 'sinon le crée
wbDest.SaveAs Rep & wbSynt 'et le sauve
End If
fSource = Dir(Rep & "*.xls") 'test fichier "xls" du dossier
While Len(fSource) > 0 And fSource <> wbDest.Name 'test fSource
Set wbSource = Workbooks.Open(Rep & fSource) 'ouvre le fichier à traiter
Set ws = wbSource.Sheets("Report") 'ouvre l'onglet à copier
nFeuille = ws.Range("L4").Text 'récupère le nom de l'onglet en L4
With wbDest
ws.Copy After:=.Sheets(.Sheets.Count) 'copie l'onglet dans le fichier de synthèse
ActiveSheet.Name = nFeuille 'renome le nouvelle feuille
End With
wbSource.Close False 'ferme wbSource
fSource = Dir() 'choisit le fichier suivant
Wend
wbDest.Close True 'enregistre et ferme wbSynt
Application.ScreenUpdating = True
End Sub