Améliorer Créer nouveau classeur et copier/coller données

[gerson94]

Bonjour tous,

Je souhaite améliorer cette macro. Là où çà bloque (en rouge), c’est que le numéro de classeur évolue chaque qu’un nouveau est crée.
Merci de votre aide.

Gerson



Sub Macro2()
'
' On crée un noouveau classeur
Set Workbook = Application.Workbooks.Add
'dans le classeur concerné et la feuille en cours on sélectionne la plage qu'on copie
Windows("Test.xls").Activate
Range("AI5:AM111").Select
Selection.Copy
' dans le nouveau classeur crée on colle les informations en valeur et format
Windows("Classeur11").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


End Sub

Gerson

 

[ERIC S]

Re : Améliorer Créer nouveau classeur et copier/coller données

Bonjour

essaie en mémorisant le n° du classeur créé :

Sub Macro2()
'
' On crée un noouveau classeur
Set Workbook = Application.Workbooks.Add
nomfichier = activewindow.name

c'est de tête, si ce n'est pas .name, essaie .caption

puis tu le réouvres par

Windows(nomfichier).Activate

 

[PMO2]

Re : Améliorer Créer nouveau classeur et copier/coller données

Bonjour,

Essayez avec le code suivant

Sub Macro2_pmo()
Dim WB As Workbook
' On crée un nouveau classeur
Set WB = Application.Workbooks.Add
'dans le classeur concerné et la feuille en cours on sélectionne la plage qu'on copie
Windows("Test.xls").Activate
Range("AI5:AM111").Select
Selection.Copy
' dans le nouveau classeur crée on colle les informations en valeur et format
WB.Windows(1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub

Cordialement.

PMO
Patrick Morange

 

[gerson94]

Re : Améliorer Créer nouveau classeur et copier/coller données

Bonjour,

Essayez avec le code suivant

Sub Macro2_pmo()
Dim WB As Workbook
' On crée un nouveau classeur
Set WB = Application.Workbooks.Add
'dans le classeur concerné et la feuille en cours on sélectionne la plage qu'on copie
Windows("Test.xls").Activate
Range("AI5:AM111").Select
Selection.Copy
' dans le nouveau classeur crée on colle les informations en valeur et format
WB.Windows(1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub

Cordialement.

PMO
Patrick Morange

Salut Eric S et PMO2,

Ca fonctionne nickel! Merci beaucoup pour ce coup de main.

Bon après-midi

Gerson

 

[gerson94]

Re : Améliorer Créer nouveau classeur et copier/coller données

Salut tous,

La macro marche, j'ai ajouté quelques lignes de codes pour nommer le noouveau classeur, mais çà ne marche pas...

Sub Macro2()
'

Dim WB As Workbook
Dim Nom_Ext

' On crée un nouveau classeur
Set WB = Application.Workbooks.Add
Nom = InputBox("Veuillez saisir le nom du fichier", "Nom du fichier à créer :")
Nom_Ext = Nom & ".xls"
'Workbooks.Add     'créer un nouveau classeur

'dans le classeur concerné et la feuille en cours on sélectionne la plage qu'on copie
Windows("Test.xls").Activate
Range("AI5:AM111").Select
Selection.Copy

' dans le nouveau classeur crée on colle les informations en valeur et format
WB.Windows(1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End Sub

Merci de votre aide

Gerson

 

[ERIC S]

Re : Améliorer Créer nouveau classeur et copier/coller données

onjour

a essayer

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

 

[gerson94]

Re : Améliorer Créer nouveau classeur et copier/coller données

onjour

a essayer

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

Bonjour Eric,

Ca marche du tonnerrre. Merci

Bonne journée

Gerson