View Full Version : Solved: How To Copy Sheet1's CodeModule To An Another Sheet1's CodeModule?
Erdin? E. Ka
11-05-2008, 05:21 PM
Hi everyone:hi:
I need a code for:
copy Sheet1's CodeModule of a workbook (as Book1.xls) to Sheet1's CodeModule of an open workbook (as Book2.xls)
I can copy module1 but i can not find a way for a sheet1's codemodule!
I was tried to write to Sheet1's CodeModule but Excel Application was returned me an error and quit automaticly...
So i should find a way to copy Sheet1's CodeModule...
Please help me. :think:
Thanks inadvance...
Erdin
Greetings Erdin? -
This should work regardless of whether there is any pre-existing code in 'Sheet1' of "Book2". However, if there matching event procedures in both, she'll error when Book2 is run...
Hope this helps,
Mark
Option Explicit
Sub CopyModule_SheetMod()
Dim _
wbDest As Workbook, _
wbSource As Workbook, _
v_clsDest As VBComponent, _
v_clsSource As VBComponent, _
clsM_Dest As CodeModule, _
clsM_Source As CodeModule, _
lCnt As Long, _
lStart As Long, _
lBeg As Long
'// Set error handling to in line for the moment. //
On Error Resume Next
'// Set the destination workbook //
Set wbDest = Workbooks("Book2.xls")
'// If we encountered an error, Book2 isn't open, so warn and bail... //
If Err.Number > 0 Then
Set wbDest = Nothing
Err.Clear
On Error GoTo 0
MsgBox "Both books have to be open.", 0, ""
Exit Sub
End If
'// Reset error handling. //
On Error GoTo 0
'// Set the source wb //
Set wbSource = ThisWorkbook
'// Set the destination and source components. Note: These must be set to //
'// the codename of the sheet or the module name //
Set v_clsDest = wbDest.VBProject.VBComponents("Sheet1")
Set v_clsSource = wbSource.VBProject.VBComponents("Sheet1")
'// Set the dest/source code modules based on the components. //
Set clsM_Dest = v_clsDest.CodeModule
Set clsM_Source = v_clsSource.CodeModule
'// Loop thru source declaration lines... //
For lCnt = 1 To clsM_Source.CountOfDeclarationLines
'// If you have variable declaration req'd, this will skip copying the //
'// first line, ie - "Option Explicit", so that duplicate will be //
'// avoided. //
If InStr(1, clsM_Source.Lines(lCnt, 1), _
"Option Explicit", vbTextCompare) = 0 Then
lBeg = lBeg + 1
End If
Next
'// This should give us the line to start copying FROM in the source module //
lBeg = clsM_Source.CountOfDeclarationLines - lBeg
'// Get upper limit. //
lStart = clsM_Source.CountOfLines
For lCnt = 1 To clsM_Source.CountOfLines
'// In the destination module, in case there are already lines of code, //
'// we insert line-by-line, at the end of the destination module, using //
'// the appropriate line from the source module. //
clsM_Dest.InsertLines lCnt + lStart, clsM_Source.Lines(lCnt + lBeg, 1)
Next
'// Explicitly release everything... //
Set wbDest = Nothing
Set wbSource = Nothing
Set v_clsDest = Nothing
Set v_clsSource = Nothing
Set clsM_Dest = Nothing
Set clsM_Source = Nothing
End Sub
OOPS!
I forgot to mention: You need to set a reference to VBIDE.
If this sounds unfamiliar, go to Tools | References, and scroll til you find: "Microsoft Visual Basic for Applications Extensibility 5.3"
Tick the checkbox, and <OK> button to add the library.
Of course you may also use late-binding...
Mark
Erdin? E. Ka
11-06-2008, 08:43 AM
Greetings Erdin? -
This should work regardless of whether there is any pre-existing code in 'Sheet1' of "Book2". However, if there matching event procedures in both, she'll error when Book2 is run...
Hope this helps,
Mark
&
OOPS!
I forgot to mention: You need to set a reference to VBIDE.
If this sounds unfamiliar, go to Tools | References, and scroll til you find: "Microsoft Visual Basic for Applications Extensibility 5.3"
Tick the checkbox, and <OK> button to add the library.
Of course you may also use late-binding...
Mark
Hi Mark :hi:
The Code is working perfect! I very very thank you to your help and descriptions.
:friends: :whistle:
Hi Erdin? -
Very happy to help and glad it worked:thumb .
Have a great weekend,
Mark
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.