Option Explicit
Sub CreationFichier()
Dim n&, chemin$, w As Worksheet, t$, Wb As Workbook
With Application
.ScreenUpdating = False
.DisplayAlerts = False 'si un fichier existe déjà
End With
n = Application.SheetsInNewWorkbook 'nombre de feuilles des nouveaux classeurs
Application.SheetsInNewWorkbook = 1
chemin = ThisWorkbook.Path & "\" 'chemin d'accès à adapter
For Each w In Worksheets
t = Mid(w.[C3].Formula, 2)
On Error Resume Next
t = Range(t).Address
If Err = 0 Then
Set Wb = Workbooks.Add 'nouveau document
w.Cells.Copy Wb.Sheets(1).Cells 'copie de la feuille
Wb.Sheets(1).UsedRange = Wb.Sheets(1).UsedRange.Value 'supprime les formules (facultatif)
Wb.Sheets(1).Name = w.Name 'renomme la feuille du nouveau document
With ActiveSheet.PageSetup
.PrintArea = Range("$A$1:" & ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Address)
.FitToPagesWide = 1
.FitToPagesTall = 1
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Zoom = False
End With
Wb.SaveAs chemin & Epure(w.Name) 'crée le fichier sur le disque dur
Wb.Close
End If
Next
Application.SheetsInNewWorkbook = n
End Sub