Bonjour toutes et tous,
Grâce à vous j'ai pu mettre en place ce code qui me permet de créer un nouveau classeur et faire du copier coller des onglets.
Il fonctionne bien, mais je souhaite le raccoucir, l'optimiser surtout au niveau du copier/coller....
Merci d'avance et bon appétit.
Gerson🙂
Grâce à vous j'ai pu mettre en place ce code qui me permet de créer un nouveau classeur et faire du copier coller des onglets.
Il fonctionne bien, mais je souhaite le raccoucir, l'optimiser surtout au niveau du copier/coller....
Code:
Sub Macro()
Dim WB As Workbook
Dim Nom_Ext As String
'On crée un nouveau classeur
Set WB = Application.Workbooks.Add
Nom = InputBox("Veuillez saisir le nom du fichier", "Nom du fichier à créer :")
If Nom = "" Then MsgBox "Abandon": Exit Sub
Nom_Ext = Nom & ".xls"
ActiveWindow.Caption = Nom_Ext
'dans l'outil on sélectionne la feuille "Aff"
ThisWorkbook.Activate
Sheets("Aff").Select
Range("A1:S1650").Select
Selection.Copy
'dans le nouveau classeur crée on colle les informations en valeur et format
WB.Windows(1).Activate
Sheets("Feuil1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'dans l'outil on sélectionne la feuille "Dis"
ThisWorkbook.Activate
Sheets("Dis").Select
Range("B7:M110").Select
Selection.Copy
'dans le nouveau classeur crée on colle les informations en valeur et format
WB.Windows(1).Activate
Sheets("Feuil2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'dans l'outil on sélectionne la feuille "Pré"
ThisWorkbook.Activate
Sheets("Pré").Select
Range("A4:J30").Select
Selection.Copy
'dans le nouveau classeur crée on colle les informations en valeur et format
WB.Windows(1).Activate
Sheets("Feuil3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Merci d'avance et bon appétit.
Gerson🙂