Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim n%, chemin$, fichier$
If Val(Application.Version) < 12 Or Right(Me.Name, 4) = ".xls" Then Exit Sub
Me.Save 'sauvegarde
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier .xls existe déjà
With Application
n = .SheetsInNewWorkbook
.SheetsInNewWorkbook = Me.Worksheets.Count
Workbooks.Add 'nouveau document
.SheetsInNewWorkbook = n
End With
With ActiveWorkbook
For n = 1 To .Worksheets.Count
With .Worksheets(n)
Me.Worksheets(n).Cells.Copy .Cells
.UsedRange = .UsedRange.Value
.Name = Me.Worksheets(n).Name
End With
Next
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Left(Me.Name, Len(Me.Name) - 5) & ".xls"
.SaveAs chemin & fichier, 56
.Close
End With
End Sub