Il faut 2 choses ...
- cocher la réference Microsoft Visual Basic for Applications Extensibility 5.3
- et ceci :
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