Sub CopierFichiersFermés()
Dim chemin$, w As Worksheet, feuil$, ad$, dest As Range
Dim nlig&, ncol%, fichier$, f$, i%
chemin = ThisWorkbook.Path & "\"
Set w = Feuil1 'CodeName de la feuille Tous
feuil = w.[C3]
ad = "I98:AN112" 'à adapter
Set dest = w.[D5] 'cellule de destination
nlig = Range(ad).Rows.Count
ncol = Range(ad).Columns.Count
ad = Range(ad).Cells(1).Address(0, 0) '1ère cellule
fichier = Dir(chemin & "tablserv_SansMdP*.xlsm") '1er fichier du dossier
Application.ScreenUpdating = False
On Error Resume Next 'si la feuille n'existe pas
dest(1, -1).Resize(Rows.Count - dest.Row + 1, ncol + 2).Clear 'RAZ
While fichier <> ""
If fichier <> ThisWorkbook.Name Then 'au cas où...
fichier = Replace(fichier, "'", "''")
f = "='" & chemin & "[" & fichier & "]" & feuil & "'!" & ad
dest = f 'pour tester
If dest.Text = "#REF!" Then
dest = ""
Else
With dest.Resize(nlig, ncol)
.Formula = f 'copie la formule
.Value = .Value 'supprime les formules
.Replace 0, "", xlWhole 'valeurs zéro
For i = 7 To 10
.Borders(i).Weight = xlThin
Next
.Borders(xlInsideHorizontal).Weight = xlHairline
.Borders(xlInsideVertical).Weight = xlHairline
.Columns(1).Borders(xlEdgeRight).Weight = xlThin
.Columns(2).Resize(, ncol - 1).HorizontalAlignment = xlCenter
End With
With dest(1, -1).Resize(, 2)
.Merge 'fusionne
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 49 'bleu
.Font.Bold = True 'gras
.Font.ColorIndex = 2 'blanc
fichier = Replace(fichier, "''", "'")
.Value = fichier
End With
Set dest = dest.Offset(nlig)
End If
End If
fichier = Dir 'fichier suivant du dossier
Wend
w.Activate
End Sub