T
tom taol
i need sheet code copy many sheets from a sheet except specific sheets
only, for example, sheet name is the Curr2, xCurr, Curr3. but ,
unhappinesly this code exit xl program.
Sub sbVBECopyEvnt(wb, sSrc)
Dim x As VBIDE.VBComponent
Dim codModul As VBIDE.CodeModule
With wb.VBProject
Set codModul = .VBComponents.Item(sSrc.CodeName).CodeModule
srCodSrc = codModul.Lines(1, codModul.CountOfLines)
For Each x In .VBComponents
If x.Type = vbext_ct_Document Then 'x.name==thisworkbook,
sheet2...
namSht = x.Properties("name")
If x.Name <> "ThisWorkbook" And sSrc.CodeName <> x.Name And _
CBool(InStr(1, namSht, "Curr")) = False Then
x.CodeModule.DeleteLines 1, x.CodeModule.CountOfLines
x.CodeModule.AddFromString srCodSrc
End If
End If
Next
End With
End Sub
Sub sbVBECopyEvnt_tst()
Call sbVBECopyEvnt(ActiveWorkbook, ActiveWorkbook.Sheets("01"))
End Sub
*** Sent via Developersdex http://www.developersdex.com ***
only, for example, sheet name is the Curr2, xCurr, Curr3. but ,
unhappinesly this code exit xl program.
Sub sbVBECopyEvnt(wb, sSrc)
Dim x As VBIDE.VBComponent
Dim codModul As VBIDE.CodeModule
With wb.VBProject
Set codModul = .VBComponents.Item(sSrc.CodeName).CodeModule
srCodSrc = codModul.Lines(1, codModul.CountOfLines)
For Each x In .VBComponents
If x.Type = vbext_ct_Document Then 'x.name==thisworkbook,
sheet2...
namSht = x.Properties("name")
If x.Name <> "ThisWorkbook" And sSrc.CodeName <> x.Name And _
CBool(InStr(1, namSht, "Curr")) = False Then
x.CodeModule.DeleteLines 1, x.CodeModule.CountOfLines
x.CodeModule.AddFromString srCodSrc
End If
End If
Next
End With
End Sub
Sub sbVBECopyEvnt_tst()
Call sbVBECopyEvnt(ActiveWorkbook, ActiveWorkbook.Sheets("01"))
End Sub
*** Sent via Developersdex http://www.developersdex.com ***