Private Sub CommandButton3_Click()
Dim cl1 As Workbook
Dim cl2 As Workbook
Dim g
Dim h As Variant
Dim i As Variant
On Error GoTo Erreur
Application.ScreenUpdating = False
Set cl1 = ThisWorkbook
Set cl2 = Workbooks.Add(xlWBATWorksheet)
cl2.Sheets(1).Name = "rien"
For g = 1 To cl1.Sheets.Count
cl2.Sheets.Add after:=cl2.Sheets(cl2.Sheets.Count)
cl1.Sheets(g).Cells.Copy Destination:=cl2.ActiveSheet.Range("A1")
'cl1.Sheets(g).Copy after:=cl2.Sheets(cl2.Sheets.Count)
Next g
Application.DisplayAlerts = False
cl2.Sheets(1).Delete
h = "Nommer votre fichier"
i = Application.GetSaveAsFilename( _
InitialFileName:=h, _
fileFilter:="Classeur Microsoft Excel (*.xls), *.xls")
If i <> False Then cl2.SaveAs Filename:=i
cl1.Saved = True
cl1.Close
Erreur:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub