'Sauvegarder une feuille d'un fichier Excel dans un autre fichier Excel
Sub ExportWorkbooksVersXls()
'Source : http://www.mrexcel.com/archive/VBA/5788.html
'Tite : Re: MACRO to save worksheets as seperate files ?
'Date : 14/11/2001
'Auteur : Dank
'Crée un fichier Excel séparé pour chaque feuille présente dans le document actif
Dim i, l As Integer
Dim wbDest As Workbook
Dim wbSource As Workbook
'La feuille à copier peut être un tableur, un graphique, etc...
Dim sht As Object
Dim strSavePath As String
On Error GoTo ErrorHandler
Set wbSource = ActiveWorkbook
strSavePath = wbSource.Path
'Pour chaque feuille du document actif
For Each sht In wbSource.Sheets
Set sht = wbSource.ActiveSheet
sht.Copy
Set wbDest = ActiveWorkbook
strSavePath = Application.GetSaveAsFilename(strSavePath & "\" & sht.Name, fileFilter:="xls Files (*.xls), *.xls")
'Désactive les alertes pour éviter à l'utilisateur de devoir confirmer la sauvegarde du fichier
Application.DisplayAlerts = False
If strSavePath <> "False" Then
wbDest.SaveAs strSavePath
End If
wbDest.Close
Next
Application.DisplayAlerts = True
Exit Sub
'Gestionnaire d'erreurs
ErrorHandler:
MsgBox "Une erreur s'est produite. Numéro de l'erreur=" & Err.Number & ". Description de l'erreur =" & Err.Description & "."
End Sub