Copy a procedure from one project to another

[Brettjg]

I'm just working with Chip Pearson's excellent website to upgrade some
modules etc from a master workbook. The only thing missing is how to copy a
procedure from one project to another (specifically sheetchange events and
workbook open...so I can't just copy the module). Does someone have a pointer
for me please? Regards, Brett.

 

[Chip Pearson]

The following code will copy the "Workbook_Open" and
"Workbook_SheetChange" procedures from the ThisWorkbook code module in
Book1.xls to the ThisWorkbook code module in Book2.xls. If
Workbook_Open or Workbook_SheetChange already exist in Book2.xls, they
are deleted before copying over from Book1.xls.

''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CopyFromBook1ToBook2()
Dim CodeMod1 As VBIDE.CodeModule
Dim CodeMod2 As VBIDE.CodeModule
Dim ProcStartLine As Long
Dim ProcCountLine As Long
Dim S As String

Set CodeMod1 = Workbooks("Book1.xls").VBProject. _
VBComponents("ThisWorkbook").CodeModule
Set CodeMod2 = Workbooks("Book2.xls").VBProject. _
VBComponents("ThisWorkbook").CodeModule

' Workbook_Open
With CodeMod1
ProcStartLine = .ProcStartLine("Workbook_Open", vbext_pk_Proc)
ProcCountLine = .ProcCountLines("Workbook_Open", vbext_pk_Proc)
S = .Lines(ProcStartLine, ProcCountLine)
End With

With CodeMod2
' Delete existing Workbook_Open
On Error Resume Next
Err.Clear
ProcStartLine = .ProcStartLine("Workbook_Open", vbext_pk_Proc)
If Err.Number = 0 Then
ProcCountLine = .ProcCountLines("Workbook_Open",
vbext_pk_Proc)
.DeleteLines ProcStartLine, ProcCountLine
End If
.InsertLines .CountOfLines + 1, S
End With

' Workbook_SheetChange
With CodeMod1
ProcStartLine = .ProcStartLine("Workbook_SheetChange",
vbext_pk_Proc)
ProcCountLine = .ProcCountLines("Workbook_SheetChange",
vbext_pk_Proc)
S = .Lines(ProcStartLine, ProcCountLine)
End With

With CodeMod2
' Delete existing Workbook_Open
On Error Resume Next
Err.Clear
ProcStartLine = .ProcStartLine("Workbook_SheetChange",
vbext_pk_Proc)
If Err.Number = 0 Then
ProcCountLine = .ProcCountLines("Workbook_SheetChange",
vbext_pk_Proc)
.DeleteLines ProcStartLine, ProcCountLine
End If
.InsertLines .CountOfLines + 1, S
End With

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''





Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[Brettjg]

Hey Chip, thanks for that, and a really big thanks for your amazingly
informative website. Your genorosity with your knowledge ie exceptional.
Brett (in Oz, btw).