Option Explicit
'RW02
'http://www.excel-downloads.com/forum/242796-macro-excel.html#post1561007
Sub Synthese_Fichiers()
Dim Chemin As String, Fichier As String, Synthese As String
Dim wSynthese As Workbook, wFichier As Workbook
Dim Feuilles
Dim i As Long, j As Long, c
'Définit le répertoire d'origine des fichiers (identique pour la synthèse et les autres)
Chemin = ThisWorkbook.Path
Fichier = Dir(Chemin & "\*.xlsx")
Synthese = ThisWorkbook.Name
'Définit la variable classeur
Set wSynthese = ThisWorkbook
Feuilles = Array("PQF1", "PQF2", "PQF3")
'Boucle sur tous les fichiers du répertoire
'On vérifie que le nom du fichier est différent de celui de synthèse
'Et que le fichier dispose bien d'un nom
Do While Fichier <> Synthese And Len(Fichier) > 0
'On ouvre le fichier et on définit la variable
Workbooks.Open (Chemin + "\" + Fichier): Set wFichier = ActiveWorkbook
'On boucle chaque feuille du classeur
For Each c In Feuilles
'On définit la dernière ligne de chaque onglet
i = wSynthese.Sheets(c).[b65000].End(xlUp).Row + 1 '+1 pour coller après la dernière ligne
j = wFichier.Sheets(c).[b65000].End(xlUp).Row
'On vérifie que la dernière ligne (j) soit supérieure à 5 et on copie colle les lignes
'Sinon on passe à la prochaine étape
If j > 5 Then wFichier.Sheets(c).Rows("6:" & j).Copy wSynthese.Sheets(c).Cells(i, "a")
Next c
'On ferme le classeur ouvert
wFichier.Close False
Fichier = Dir()
Loop
'A conserver si tu le souhaites seulement
With wSynthese
For Each c In Feuilles
j = 1
For i = 6 To .Sheets(c).[a65000].End(xlUp).Row Step 2
.Sheets(c).Cells(i, "a").Value = j
j = j + 1
Next i
Next c
End With
End Sub