Solved: Copy sheet to new workbook without copying the code?

[paulked]

I have the following code in Sheet1(Main)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$3" And Worksheets("Main").Range("G3") = "1" _
And Worksheets("Main").Range("G4") = "0" Then
Call ClearCells
Call InsertDateAndTime
Worksheets("Main").Range("G4").Value = 1
End If
If Target.Address = "$G$3" And Worksheets("Main").Range("G3") = "0" _
And Worksheets("Main").Range("G4").Value = 1 Then
Call SaveBoat
Worksheets("Main").Range("G4").Value = 0
End If
End Sub


The sub SaveBoat
Sub SaveBoat()
Dim SavePath As String
Dim LYear As Integer
Dim LWeek As String
Dim fso
Dim fol As String
'Application.SendKeys "%me"
'Application.SendKeys "{ENTER}"
'Application.Wait Now + TimeSerial(0, 0, 20)
Call RemoveSpaces
Sheets("Main").Select
Sheets("Main").Copy
Sheets("Main").Select
Sheets("Main").Name = "Sheet1"
LYear = Year(Date)
LWeek = DatePart("ww", Now())
fol = "C:\Ovens\Records\" & LYear
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(fol) Then
fso.CreateFolder (fol)
End If
fol = fol & "\" & "Week " & LWeek & "\"
If Not fso.FolderExists(fol) Then
fso.CreateFolder (fol)
End If
fol = fol & Range("F1").Text & "\"
If Not fso.FolderExists(fol) Then
fso.CreateFolder (fol)
End If
ActiveWorkbook.SaveAs Filename:=(fol & Range("A1").Value & ".XLS")
ActiveWorkbook.Close
Range("A1").Select
'Application.SendKeys "%mb"
'Application.SendKeys "{ENTER}"
'Application.Wait Now + TimeSerial(0, 0, 20)
End Sub

copies this sheet to a new workbook.

Is there a way to copy this sheet without the Private Sub Worksheet_Change code being included?

Any help much appreciated

Thanks

Paul Ked

[mdmackillop]

Sub SaveBoat()
Dim SavePath As String
Dim LYear As Integer
Dim LWeek As String
Dim fso
Dim fol As String
'Application.SendKeys "%me"
'Application.SendKeys "{ENTER}"
'Application.Wait Now + TimeSerial(0, 0, 20)
Call RemoveSpaces
Sheets("Main").Copy
ActiveSheet.Name = "Sheet1"
LYear = Year(Date)
LWeek = DatePart("ww", Now())
fol = "C:\Ovens\Records\" & LYear
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(fol) Then
fso.CreateFolder (fol)
End If
fol = fol & "\" & "Week " & LWeek & "\"
If Not fso.FolderExists(fol) Then
fso.CreateFolder (fol)
End If
fol = fol & Range("F1").Text & "\"
If Not fso.FolderExists(fol) Then
fso.CreateFolder (fol)
End If

Call DelCode

ActiveWorkbook.SaveAs Filename:=(fol & Range("A1").Value & ".XLS")
ActiveWorkbook.Close
Range("A1").Select
'Application.SendKeys "%mb"
'Application.SendKeys "{ENTER}"
'Application.Wait Now + TimeSerial(0, 0, 20)
End Sub

Sub DelCode()
With ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule
.DeleteLines 1, .CountOfLines
End With
End Sub

[paulked]

Excellent :beerchug:

Many thanks

Paul Ked

[mdmackillop]

BTW, You should put your fso code in a separate sub and pass the variables. It's neater and easier to maintain

[paulked]

BTW, You should put your fso code in a separate sub and pass the variables. It's neater and easier to maintain

Thanks, I'll do that :clever: