Sub CopieFeuilles()
Dim n%, F As Object, Sh As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier TOTO.xls existe déjà
Set F = ThisWorkbook.Sheets(Array("affaire1", "affaire3")) 'feuilles à copier
With Application
n = .SheetsInNewWorkbook
.SheetsInNewWorkbook = F.Count
Workbooks.Add 'nouveau document
.SheetsInNewWorkbook = n
End With
With ActiveWorkbook
n = 0
For Each Sh In F
n = n + 1
With .Sheets(n)
Sh.Cells.Copy .Cells
.UsedRange = .UsedRange.Value
.Name = Sh.Name
End With
Next
.SaveAs "C:\Users\Alain\Desktop\" & "TOTO.xls" '"C:\" & "TOTO.xls" 'plus facile à tester
.Close
End With
End Sub