1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
|
Public Sub Copie_Feuille_Nouveau_Classeur(Nom_Nouveau_Classeur As String, Nom_Feuille_Source As String, Nom_Feuille_Destination As String)
Dim XLApp As New Excel.Application
Dim XLBook_destination As Workbook
Dim XLSheet_destination As Worksheet, XLSheet_Source As Worksheet
Dim XLRange_destination As Range
ThisWorkbook.Sheets(Nom_Feuille_Source).Range("A1").Select
XLApp.SheetsInNewWorkbook = 1
Set XLBook_destination = XLApp.Workbooks.Add
XLBook_destination.SaveAs Nom_Nouveau_Classeur
Set XLSheet_destination = XLBook_destination.Worksheets(1)
XLSheet_destination.Name = Nom_Feuille_Destination
Set XLSheet_destination = Nothing
XLBook_destination.Save
XLApp.Quit
Set XLBook_destination = Nothing
Workbooks.Open Nom_Nouveau_Classeur, 0, ReadOnly:=False
Set XLBook_destination = Workbooks(ActiveWorkbook.Name)
Set XLRange_destination = XLBook_destination.Sheets(Nom_Feuille_Destination).Range("A1")
Set XLSheet_Source = ThisWorkbook.Sheets(Nom_Feuille_Source)
XLSheet_Source.Cells.Copy XLRange_destination
XLBook_destination.Save
XLBook_destination.Close
Set XLApp = Nothing
Set XLBook_destination = Nothing
Set XLSheet_destination = Nothing
Set XLSheet_Source = Nothing
Set XLRange_destination = Nothing
End Sub |
Partager