VBA code to copy a worksheet code module

[Damon Ostrander]

I was recently asked for code to copy a worksheet code module to a different worksheet. I'm posting the code here in case anybody else is interested.

Sub CodeCopy()

  'Macro to create a new sheet and copy the macro module
  'from sheet1 to it.  Must install Microsoft Visual Basic
  'for Applications Extensibility library from Tools > References.
  
  Dim i          As Integer
  Dim NewSh      As Worksheet
  Dim SrcCmod    As VBIDE.CodeModule
  Dim DstCmod    As VBIDE.CodeModule
  
  Set NewSh = Worksheets.Add(after:=Worksheets(Worksheets.Count))

  Set SrcCmod = ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule
  Set DstCmod = ActiveWorkbook.VBProject.VBComponents(NewSh.Name).CodeModule
  
  For i = 1 To SrcCmod.CountOfLines
     DstCmod.InsertLines i, SrcCmod.Lines(i, 1)
  Next i
  
End Sub

Note that this example code creates a new sheet, and copies the code module from Sheet1. There is no way to simply copy the entire code module in one step, so this code copies the code line by line in a For loop, but it appears to run very fast.

Note that you do need to set a reference to the Microsoft Visual Basic for Applications Extensibility 5.3 library via Tools > References in the Visual Basic Editor.

Keep Excelling.

 

[Joe4]

Damon,

Good stuff.

I saw a question not too long ago where someone was asking how to copy the VBA code not just to another sheet/module in the same workbook, but into a different (existing) workbook. Could the code be adapted to do something like that?

Just curious...

 

[raraschek]

Damon, I tried to implement this into my existing generate a template based sheet code, but at the end, Type mismatch (13) error shows up. Can you please help me to solve this? ? Thank you very much!

<code>
Sub btn_vytvorit_Click()
Dim ws As Worksheet
Dim wsName As String, Name As String
Dim MsgError As String
Dim wsCopyFrom As Worksheet
Set wsCopyFrom = Worksheets("vzorovy_zapis")
Dim Msg As String
Dim msgsmazat As String
Dim riadky As Range
Dim noveriadky As Range
Dim leden As Range
Set leden = Range("A17:AA62")




MsgError = "Zadaný list již existuje! Vyberte bunku s jiným kódem. Potvrďte End."

'generate ws
If ActiveCell.Column <> 2 Then
MsgBox ("Nemáte označený kód zaměstnance")
Sheets("db_kontakty").Activate
Else

If Not IsEmpty(ActiveCell) Then
Name = ActiveCell.Value
Set ws = Worksheets.Add
ws.Move after:=Sheets(Sheets.Count)
'not to have two equal ws
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
If wks.Name = Name Then
MsgBox MsgError, vbOKOnly, "Pozor"
On Error GoTo Chyba
End If


Next wks
ws.Name = Name
'copy data from source

wsCopyFrom.Columns("A:AG").Copy
ws.Range("A1:AG1000").PasteSpecial (xlPasteAll)
ws.Range("S2").Value = ws.Name

'end of creating ws+setup row heights

Set riadky = wsCopyFrom.Range("A1:AG1000")
Set noveriadky = ws.Range("A1:AG1000")
With riadky
For r = 1 To .Rows.Count
noveriadky.Rows(r).RowHeight = .Rows(r).RowHeight
Next r
End With


Msg = "Vložte údaje"
MsgBox (Msg)

Chyba:
Sheets("db_kontakty").Activate




End If
End If

Dim i As Integer
Dim SrcCmod As VBIDE.CodeModule
Dim DstCmod As VBIDE.CodeModule


Set SrcCmod = ActiveWorkbook.VBProject.VBComponents(wsCopyFrom).CodeModule

Set DstCmod = ActiveWorkbook.VBProject.VBComponents(ws).CodeModule

For i = 1 To SrcCmod.CountOfLines
DstCmod.InsertLines i, SrcCmod.Lines(i, 1)
Next i


End Sub

</code>

 

[Damon Ostrander]

Hi raraschek,

I believe the problem is that in my code the VBComponents argments should be sheet names (text strings), not worksheet objects. So for example, wsCopyFrom should be "vzorovy_zapis".

Damon

 

[Frasette]

Hi everybody,

I am new in this forum.
I was looking for a function to copy worksheet code from one sheet to another and I came across this great five-year-old post. I was able to adapt Damon Ostrander's code to my case and it seemed to work fine.
However, I noticed that the code I copied into the target sheet is not there anymore after save (as .xlsm), close and reopen.
Just to provide some context, my program takes a 1000 row file and creates subfiles that contain a subset of its rows, and should retain its worksheet code.

...
esito = CodeCopy (SourceSheet, TargetSheet)

'here an omitted piece of code deletes unnecessary sheets
           
            TargetSheet.Protect AllowFormattingCells:=True, AllowFormattingRows:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True
            
            ActiveWorkbook.Protect
            
'save and close
            ActiveWorkbook.Save
'I have checked and the worksheet code is present in the target sheet if I stop execution here
            ActiveWorkbook.Close
'When I reopen the workbook, the worksheet code is not there

I analyzed commenting out the lines between the CodeCopy call and the Close, and I found out that, if I keep the unnecessary sheets (including the CodeCopy SourceSheet), I will find the worksheet code where I expect.
So, as a workaround, I am keeping the unnecessary SourceSheet, hidden and cleared from all data. but what is actually going on?

Any Ideas?
Thanks in advance and happy New Year