Having a problem! Hope someone can assist.

Have a workbook that when I click a button I want it to copy what is on the
active sheet to a new workbook.
It all works fine with the following code (it also needs to paste values
only, remove buttons but leave a logo, protect the sheet so the recipient
can't make changes and save the workbook with the value of B31- again all of
this works).

Issue is the sheet is a bit different in that I just click on cells to
activate a score. This also changes the cells colour. When the new work book
is opened and one of these scoring cells is clicked (the recipients will no
doubt try to change their scores!) I get a "run time error 1004 - Unable to
set the Colour index property of the font class." Debugging brings up the
code for this sheet in VBA (No modules) which appears to have been copied
from the original workbook.

Any ideas to stop this???

Code for creating the new workbook appears below...

Sub Make_New_Book()

Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim sh As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ThisWorkbook
Sheets("Monitoring Template").Copy

'Set Destwb to the new workbook
Set Destwb = ActiveWorkbook

'Change all cells in the worksheet to values if you want
If Destwb.Sheets(1).ProtectContents = False Then
With Destwb.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False
End If

For Each sShape In ActiveSheet.Shapes
If sShape.Name < "LOGO" Then sShape.Delete
Next sShape

'Save the new workbook and close it
ActiveSheet.Protect ("password")
ActiveWorkbook.SaveAs Filename:=Range("B31").Value
ActiveWorkbook.Close

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Tucker,

if you add this line:
Destwb.VBProject.VBComponents(activesheet.CodeName ).CodeModule.DeleteLines
1, Destwb.VBProject.VBComponents(activesheet.CodeName ).CodeModule.CountOfLines

that will delete all of the code behind the sheet. Before you run the code,
you need to allow programmatic access to VB, which is done by going to
Tools\Macros\Security, select the "Trusted Publishers" tab and check "Trust
access to Visual Basic Project"


"Tucker" wrote:

Having a problem! Hope someone can assist.

Have a workbook that when I click a button I want it to copy what is on the
active sheet to a new workbook.
It all works fine with the following code (it also needs to paste values
only, remove buttons but leave a logo, protect the sheet so the recipient
can't make changes and save the workbook with the value of B31- again all of
this works).

Issue is the sheet is a bit different in that I just click on cells to
activate a score. This also changes the cells colour. When the new work book
is opened and one of these scoring cells is clicked (the recipients will no
doubt try to change their scores!) I get a "run time error 1004 - Unable to
set the Colour index property of the font class." Debugging brings up the
code for this sheet in VBA (No modules) which appears to have been copied
from the original workbook.

Any ideas to stop this???

Code for creating the new workbook appears below...

Sub Make_New_Book()

Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim sh As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ThisWorkbook
Sheets("Monitoring Template").Copy

'Set Destwb to the new workbook
Set Destwb = ActiveWorkbook

'Change all cells in the worksheet to values if you want
If Destwb.Sheets(1).ProtectContents = False Then
With Destwb.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False
End If

For Each sShape In ActiveSheet.Shapes
If sShape.Name < "LOGO" Then sShape.Delete
Next sShape

'Save the new workbook and close it
ActiveSheet.Protect ("password")
ActiveWorkbook.SaveAs Filename:=Range("B31").Value
ActiveWorkbook.Close

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Mike, you are MY HERO!!!!!!!

Thanks so much, this has been bugging me for 2 weeks!!!!!!

"Mike" wrote:

Tucker,

if you add this line:
Destwb.VBProject.VBComponents(activesheet.CodeName ).CodeModule.DeleteLines
1, Destwb.VBProject.VBComponents(activesheet.CodeName ).CodeModule.CountOfLines

that will delete all of the code behind the sheet. Before you run the code,
you need to allow programmatic access to VB, which is done by going to
Tools\Macros\Security, select the "Trusted Publishers" tab and check "Trust
access to Visual Basic Project"


"Tucker" wrote:

Having a problem! Hope someone can assist.

Have a workbook that when I click a button I want it to copy what is on the
active sheet to a new workbook.
It all works fine with the following code (it also needs to paste values
only, remove buttons but leave a logo, protect the sheet so the recipient
can't make changes and save the workbook with the value of B31- again all of
this works).

Issue is the sheet is a bit different in that I just click on cells to
activate a score. This also changes the cells colour. When the new work book
is opened and one of these scoring cells is clicked (the recipients will no
doubt try to change their scores!) I get a "run time error 1004 - Unable to
set the Colour index property of the font class." Debugging brings up the
code for this sheet in VBA (No modules) which appears to have been copied
from the original workbook.

Any ideas to stop this???

Code for creating the new workbook appears below...

Sub Make_New_Book()

Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim sh As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ThisWorkbook
Sheets("Monitoring Template").Copy

'Set Destwb to the new workbook
Set Destwb = ActiveWorkbook

'Change all cells in the worksheet to values if you want
If Destwb.Sheets(1).ProtectContents = False Then
With Destwb.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False
End If

For Each sShape In ActiveSheet.Shapes
If sShape.Name < "LOGO" Then sShape.Delete
Next sShape

'Save the new workbook and close it
ActiveSheet.Protect ("password")
ActiveWorkbook.SaveAs Filename:=Range("B31").Value
ActiveWorkbook.Close

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub