Sub Synthese()
Dim chemin$, deb As Range, ncol%, lig&, col%, feuil$, fich$, derlig As Variant, f$
chemin = ThisWorkbook.Path & "\"
With Feuil1 'CodeName de la feuille
Set deb = .[A4] '1ère cellule du tableau, à adapter
ncol = 6 'nombre de colonnes, à adapter
lig = deb.Row: col = deb.Column
feuil = .Name 'Page 1 peut être modifié
fich = Dir(chemin & "*.xls") '1er fichier .xls du dossier
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si la feuille n'existe pas
deb(2).Resize(.Rows.Count - lig, ncol + 1).ClearContents 'RAZ
While fich <> ""
If fich <> ThisWorkbook.Name Then
fich = Replace(fich, "'", "''") 'guillemets anglais doublés
derlig = ExecuteExcel4Macro("MATCH(""zzz"",'" & chemin & _
"[" & fich & "]" & feuil & "'!C" & col & ")")
If IsNumeric(derlig) Then
If derlig > lig Then
With deb(2).Resize(derlig - lig, ncol)
.Cells(1, ncol + 1) = Replace(fich, "''", "'") 'nom du fichier
f = "'" & chemin & "[" & fich & "]" & feuil & "'!R" & _
lig + 1 & "C" & col & ":R" & derlig & "C" & col + ncol - 1
.FormulaArray = "=IF(" & f & "=0,""""," & f & ")" 'formule matricielle
.Value = .Value 'supprime les formules
End With
Set deb = deb(derlig - lig + 1)
End If
End If
End If
fich = Dir 'fichier suivant
Wend
With .UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub