Sub Exporter()
Dim exclu, wb As Workbook, w As Worksheet, nom$, dossier$, chemin$, pa As Range, n%
exclu = Array("A", "B") 'noms des feuilles exclues
'---copie dans un document auxiliaire---
Application.ScreenUpdating = False
Set wb = Workbooks.Add(xlWBATWorksheet)
For Each w In ThisWorkbook.Worksheets
If IsError(Application.Match(w.Name, exclu, 0)) Then
w.Copy After:=wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.Count).UsedRange = w.UsedRange.Value 'supprime les formules
wb.Sheets(wb.Sheets.Count).Name = w.Name
End If
Next
If wb.Sheets.Count = 1 Then wb.Close False: Exit Sub
'---création des fichiers Excel et PDF---
nom = InputBox("Nom du fichier à créer, SANS EXTENSION :", , "MonFichier")
If nom = "" Then wb.Close False: Exit Sub
dossier = InputBox("Nom du sous-dossier à créer, SANS ANTISLASH \ :", , "MonDossier")
If dossier = "" Then wb.Close False: Exit Sub
Application.DisplayAlerts = False
wb.Sheets(1).Delete
chemin = ThisWorkbook.Path & "\" & dossier & "\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'création du sous-dossier
wb.SaveAs chemin & nom 'classeur Excel
Set w = wb.Sheets(1)
Set pa = w.UsedRange
For n = 2 To wb.Sheets.Count
With w.Rows(w.UsedRange.Row + w.UsedRange.Rows.Count + 1) 'décalage d'une ligne
wb.Sheets(n).UsedRange.EntireRow.Copy .Cells
Set pa = Union(pa, Intersect(w.UsedRange, .Resize(w.Rows.Count - .Row + 1)))
End With
Next
w.PageSetup.Zoom = False
w.PageSetup.FitToPagesWide = 1 'une page en largeur
w.PageSetup.PrintArea = pa.Address 'zone d'impression multiple
w.ExportAsFixedFormat xlTypePDF, chemin & nom, Quality:=xlQualityStandard 'fichier PDF
wb.Close False 'fermeture du fichier Excel
Application.ScreenUpdating = True
MsgBox "Les fichiers '" & nom & "' ont été créés..."
End Sub