Créer un classeur et copier une veuille

Hello les amis,

Je cherche une macro qui me permettrait de créer un nouveau classeur (prenant en charge les macros) dans le même dossier où se trouve le fichier qui contient la macro et d'y copier une des feuille de ce même fichier.

Avez vous ca sous la main par hasard ?

Bon début de semaine

Bonjour,

est-ce que tu veux aussi y coller la macro du classeur d'origine ? sinon pourquoi en xlsm ?

Sub dupliquer()

    chemin = ThisWorkbook.Path
    Cells.Copy
    Set wb = Workbooks.Add
    wb.Sheets(1).Paste
    Application.CutCopyMode = False
    wb.SaveAs Filename:=chemin & "\nouveau.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    wb.Close

End Sub

Salut, question très pertinente.

Il y a une private sub sur la feuille c'est pour cela.

Je regarde pour compléter le code et recopier la macro. C'est (un peu) plus complexe !

Super merci ! Ca marche deja bien !!

Il faut 2 choses ...

  • cocher la réference Microsoft Visual Basic for Applications Extensibility 5.3
  • et ceci :
    acces approuve au modele objet du projet vba

Je n'ai pas réussi à enchaîner sur l'enregistrement du nouveau fichier (je ne sais pas pourquoi, mais dans ce cas la macro recopiée disparaît).

Option Explicit

Sub dupliquer()
' cocher la réference Microsoft Visual Basic for Applications Extensibility 5.3
Dim myMacro As VBComponent, wb As Workbook, ws As Worksheet, chemin$

    chemin = ThisWorkbook.Path
    Set ws = ActiveSheet
    Set myMacro = ActiveWorkbook.VBProject.VBComponents(WsCodeName(ws))
    Set wb = Workbooks.Add
    ws.Cells.Copy
    wb.Sheets(1).Paste
    Application.CutCopyMode = False
    wb.SaveAs Filename:=chemin & "\nouveau.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    MsgBox "Recopie macro ..."
    RecopierMacro myMacro, wb.VBProject.VBComponents(WsCodeName(wb.Sheets(1)))
    MsgBox "macro recopiée !"
    'wb.Close SaveChanges:=True

End Sub

Sub RecopierMacro(depuis As VBComponent, jusque As VBComponent)
Dim i%
    With jusque.CodeModule
        For i = 1 To depuis.CodeModule.CountOfLines
            .InsertLines i, depuis.CodeModule.Lines(i, 1)
        Next
    End With
End Sub

Function WsCodeName$(ws As Object)
On Error Resume Next
With Application.VBE.MainWindow
     WsCodeName = ws.CodeName
End With
End Function

Ah c'est super t'es un as merci beaucoup !!!!

C'est super pointu et excel n'excelle pas dans cet exercice ! mais il faut reconnaître que l'on peut écrire des macros avec des macros, original !

SI j'ose abuser

Tu crois qu'on peut remplacer le "activesheet" par une feuille dont le nom se trouve dans la case h4 de l'onglet "paramètres".

Question de rajouter du pointu au pointu ?

Oui sans abuser

    Set ws = Sheets(Sheets("paramètres").Range("H4"))

Tu es merveilleux.

Ah mince il bogue.(execution 13)

Qu'est-ce qu'il y a dans Sheets("paramètres").Range("H4")

L'orthographe de paramètres est-elle exacte ?

Ou alors forcer en string

dim f$
f = Sheets("paramètres").Range("H4")
set ws=sheets(f)

Il y a juste le mot "julien" (qui du coup est le nom de la feuille à "extraire", sans majuscule, guillemet etc.)

Non c'était sans accent parametres mais jai changé.

On s'est croisé ...

forcer en string ?

dim f$
f = Sheets("paramètres").Range("H4")
set ws=sheets(f)

ou envoie ton fichier (en mp) ou une partie !

AHA ! Ce coup ci ca marche !

Merci ! On peut définitivement clore le sujet

Il manquait le value !! autant pour moi.

2djulito.xlsm (17.53 Ko)

Ahhhhh, en plus j'aurais pu le voir tout seul ca... encore merci, t'as assuré !

Malheureusement, excel est parois trop permissif, sauf dans certains cas ! Et on tombe alors dans le panneau.

Php l'est beaucoup moins.

Rechercher des sujets similaires à "creer classeur copier veuille"