Sauvegarder une feuille dans un autre fichier

'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