PDA

View Full Version : Copy Code from Module2 to Module1



omnibuster
02-22-2009, 04:56 AM
:banghead:
If i use Sheet Names as Sheet1 Sheet2 ... etc code works good.
But in my workbooks Sheet named As Sht1,Sht2... & AA1 AA2.
gived:

Run-time errer 9
Subscript out of range

In Project Windows I see:
Sheet1(Sht1)
Sheet2(Sht3)
Sheet3(Sht2)

Why dont gived SheetName Sht1 insted Sheet1?

When I sort this sheets (with other code in the modules) code use names Sht1,Sht2...and works good.

Hope you understand what i mean.


Sub CopyModule_Sht2_toSht1() 'Selle tööraamatu makro kopib töölehe nr2 makro töölehele nr 1
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
Dim Sht As Worksheet
Set wbDest = ActiveWorkbook
Set wbSource = ActiveWorkbook
Set v_clsDest = wbDest.VBProject.VBComponents("Sht1") 'iF name Sheet1-works good.
Set v_clsSource = wbSource.VBProject.VBComponents("Sht2") 'iF name Sheet2-works good.
Set clsM_Dest = v_clsDest.CodeModule
Set clsM_Source = v_clsSource.CodeModule
For lCnt = 1 To clsM_Source.CountOfDeclarationLines
If InStr(1, clsM_Source.Lines(lCnt, 1), _
"Option Explicit", vbTextCompare) = 0 Then
lBeg = lBeg + 1
End If
Next
lBeg = clsM_Source.CountOfDeclarationLines - lBeg
lStart = clsM_Source.CountOfLines
For lCnt = 1 To clsM_Source.CountOfLines
clsM_Dest.InsertLines lCnt + lStart, clsM_Source.Lines(lCnt + lBeg, 1)
Next
Set wbDest = Nothing
Set wbSource = Nothing
Set v_clsDest = Nothing
Set v_clsSource = Nothing
Set clsM_Dest = Nothing
Set clsM_Source = Nothing
End Sub

mdmackillop
02-22-2009, 05:19 AM
Set v_clsDest = wbDest.VBProject.VBComponents(Sheets("Sht1").CodeName) 'iF name Sheet1-works good.
Set v_clsSource = wbSource.VBProject.VBComponents(Sheets("Sht2").CodeName) 'iF name Sheet2-works good.

omnibuster
02-22-2009, 10:22 AM
Thanks mdmackillop. (Very quick & good work).

In this Sample file (litle part of my Project) the code works good.
But in my real "BIG Project" this code dont work???

With button in the “HEAD” File I want refresh File “Sample.
Here part of this file:

mdmackillop
02-22-2009, 12:26 PM
Sub CopyModule_Sht2_toSht1() 'Selle tööraamatu makro kopib töölehe nr2 makro töölehele nr 1
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
On Error Resume Next
Set wbDest = ActiveWorkbook
If Err.Number > 0 Then
Set wbDest = Nothing
Err.Clear
On Error GoTo 0
MsgBox "Sheets existing??"
Exit Sub
End If
On Error GoTo 0
Set wbSource = ThisWorkbook
Set v_clsDest = wbDest.VBProject.VBComponents(Sheets("Sht1").CodeName)
Set v_clsSource = wbSource.VBProject.VBComponents(Sheets("Sht2").CodeName)
Set clsM_Dest = v_clsDest.CodeModule
Set clsM_Source = v_clsSource.CodeModule
For lCnt = 1 To clsM_Source.CountOfLines
If InStr(1, clsM_Source.Lines(lCnt, 1), _
"Option Explicit", vbTextCompare) = 0 Then
lBeg = lBeg + 1
End If
Next
lBeg = clsM_Source.CountOfLines - lBeg
lStart = clsM_Source.CountOfLines
For lCnt = 1 To clsM_Source.CountOfLines
clsM_Dest.InsertLines lCnt + lStart, clsM_Source.Lines(lCnt + lBeg, 1)
Next
Set wbDest = Nothing
Set wbSource = Nothing
Set v_clsDest = Nothing
Set v_clsSource = Nothing
Set clsM_Dest = Nothing
Set clsM_Source = Nothing
End Sub

omnibuster
02-22-2009, 01:38 PM
In this place gived same error 9


Set v_clsDest = wbDest.VBProject.VBComponents(Sheets("Sht1").CodeName)

Set v_clsDest=Nothing ???

mdmackillop
02-22-2009, 02:05 PM
Can you summarise what your code should be doing?

omnibuster
02-22-2009, 02:18 PM
If in the Sheet Sht1 or in the Sheet AA1 Range IU1 not empty
(Sheet completed=full) then insert new Sheet, rename this Sht1 or AA1 & copy worksheetcode Sht2 or AA2 to Sht1 or AA1.

mdmackillop
02-22-2009, 02:42 PM
Are you copying code within Head or Sample of from one to the other?

If your code is simply that shown in Sample Sheet2, you can put code in ThisWorkbook which will handle a DoubleClick event from ant shhet, so no need for code in each sheet.
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
With Sh
.Range("A1").Copy .Range("E1")
.Range("H1").Copy .Range("A2")
.Range("A1").Activate
End With
End Sub

omnibuster
02-22-2009, 11:31 PM
Thanks mdmackillop.
That simple code was just excample.
Real code more complicated.