Delete sheet code

  • Thread starter Thread starter Gareth
  • Start date Start date
G

Gareth

I am using the code below (which I got from this NG) in a macro that copies
6 sheets from file A into a new file.

The sheet code is not required in the new file so is deleted using the
following:

Dim VBComp As VBIDE.VBComponent, Wb As Excel.Workbook
Set Wb = ActiveWorkbook
For Each VBComp In Wb.VBProject.VBComponents
Select Case VBComp.Type
Case vbext_ct_Document
With VBComp.CodeModule
..DeleteLines StartLine:=1, Count:=.CountOfLines
End With
Case Else
Wb.VBProject.VBComponents.Remove VBComp
End Select
Next VBComp

I now find that I need to keep the code in 2 sheets that are copied - sheet1
and sheet2.

Could someone suggest how to alter the code in order to achieve this?

Thanks in advance

Gareth
 
Try this

This will only delete the code in Sheet3 - 6
Maybe you must change ThisWorkbook to ActiveWorkbook?

Sub test()
Dim VBCodeMod As CodeModule
Dim StartLine As Long
Dim HowManyLines As Long
Dim sh As Worksheet

For Each sh In ThisWorkbook.Sheets(Array("Sheet3", "Sheet4", "Sheet5", "Sheet6"))
Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(sh.Name).CodeModule
With VBCodeMod
StartLine = 1
HowManyLines = .CountOfLines
.DeleteLines StartLine, HowManyLines
End With
Next
End Sub
 
Gareth,

This should do it

Dim VBComp As VBIDE.VBComponent, Wb As Excel.Workbook
Set Wb = ActiveWorkbook
For Each VBComp In Wb.VBProject.VBComponents
With VBComp
Select Case .Type
Case vbext_ct_Document
If .CodeModule <> "Sheet1" And .CodeModule <> "Sheet2"
Then
With .CodeModule
.DeleteLines StartLine:=1, Count:=.CountOfLines
End With
Case Else
Wb.VBProject.VBComponents.Remove VBComp
End Select
End With
Next VBComp



--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
This doesn't delete code in sheets with tab names of Sheet1 and Sheet3.
Replace the sheet names you want to exclude with all lowercase versions of
their names.
Sub AAAtester1()

Dim VBComp As VBIDE.VBComponent, Wb As Excel.Workbook
Dim prop As VBIDE.Property
Set Wb = ActiveWorkbook
For Each VBComp In Wb.VBProject.VBComponents
Select Case VBComp.Type
Case vbext_ct_Document
If LCase(VBComp.Properties("Name")) <> "sheet1" _
And LCase(VBComp.Properties("Name")) <> "sheet3" Then
With VBComp.CodeModule
.DeleteLines StartLine:=1, Count:=.CountOfLines
End With
End If
Case Else
Wb.VBProject.VBComponents.Remove VBComp
End Select
Next VBComp
End Sub
 
Back
Top