Save worksheet to seperate file?

[Guest]

I have the following code that saves one sheet to a folder. What I`m after is
to save the sheet so that it can not be altered and rename the tap name to
the contents of cell "E1". Also I would like to keep adding the same sheet to
the same folder but with different Tap name.........ie 2006, 2007, 2008 so on.
Here is the code I have so far:

Private Sub CommandButton1_Click()
Dim myFileName As String
With ActiveWorkbook
Worksheets("Sheet2").Copy 'to new workbook
With ActiveSheet
With .UsedRange
..Copy
..PasteSpecial Paste:=xlPasteValues 'remove formulas???
End With
'pick up the name from some cells???
myFileName = .Range("e1").Value & ".xls"
myFileName = "C:\Documents and Settings\All Users\Desktop\ & myFileName"
..Parent.SaveAs Filename:=myFileName, FileFormat:=xlWorkbookNormal
..Parent.Close savechanges:=False
End With
End With
End Sub

 

[Guest]

Change...

myFileName = "C:\Documents and Settings\All Users\Desktop\ & myFileName"
to
myFileName = "C:\Documents and Settings\All Users\Desktop\" & myFileName

--
HTH,
Gary Brown
(e-mail address removed)
If this post was helpful to you, please select ''YES'' at the bottom of the
post.

 

[Guest]

Thanks Gary for the reply. That works, but I`m still able to amend the data
on the copied sheet. In other words I want the copy as information only so
that others can not change any of the data on it.

 

[Guest]

Try this...

'/================================================/
Private Sub CommandButton1_Click()
Dim myFileName As String
With ActiveWorkbook
Worksheets("Sheet2").Copy 'to new workbook
With ActiveSheet
With .UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues 'remove formulas???
End With
'pick up the name from some cells???
myFileName = .Range("e1").Value & ".xls"
'*** Double protect against changing workbook
'1) Protect the worksheet against inadvertent changes
' EXCEPT for unlocked cells
'2) Password protect the workbook so that it is 'Write'
' protected
'***
'Create password for 'Write' permission for workbook
Dim strPassword As String
strPassword = "George"
'Protect the worksheet so that it can not be changed
' unless individual cells are unlocked
ActiveSheet.Protect DrawingObjects:=True, _
Contents:=True, Scenarios:=True
myFileName = .Range("e1").Value & ".xls"
myFileName = _
"C:\Documents and Settings\All Users\Desktop\" & _
myFileName
Application.DisplayAlerts = False
.Parent.SaveAs Filename:=myFileName, _
FileFormat:=xlNormal, Password:="", _
WriteResPassword:=strPassword, _
ReadOnlyRecommended:=True, _
CreateBackup:=False
.Parent.Close savechanges:=False
Application.DisplayAlerts = True
End With
End With

End Sub
'/================================================/
---
HTH,
Gary Brown
(e-mail address removed)
If this post was helpful to you, please select ''YES'' at the bottom of the
post.

 

[Guest]

Just the job.
Thanks very much.
--
George

Try this...

'/================================================/
Private Sub CommandButton1_Click()
Dim myFileName As String
With ActiveWorkbook
Worksheets("Sheet2").Copy 'to new workbook
With ActiveSheet
With .UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues 'remove formulas???
End With
'pick up the name from some cells???
myFileName = .Range("e1").Value & ".xls"
'*** Double protect against changing workbook
'1) Protect the worksheet against inadvertent changes
' EXCEPT for unlocked cells
'2) Password protect the workbook so that it is 'Write'
' protected
'***
'Create password for 'Write' permission for workbook
Dim strPassword As String
strPassword = "George"
'Protect the worksheet so that it can not be changed
' unless individual cells are unlocked
ActiveSheet.Protect DrawingObjects:=True, _
Contents:=True, Scenarios:=True
myFileName = .Range("e1").Value & ".xls"
myFileName = _
"C:\Documents and Settings\All Users\Desktop\" & _
myFileName
Application.DisplayAlerts = False
.Parent.SaveAs Filename:=myFileName, _
FileFormat:=xlNormal, Password:="", _
WriteResPassword:=strPassword, _
ReadOnlyRecommended:=True, _
CreateBackup:=False
.Parent.Close savechanges:=False
Application.DisplayAlerts = True
End With
End With

End Sub
'/================================================/
---
HTH,
Gary Brown
(e-mail address removed)
If this post was helpful to you, please select ''YES'' at the bottom of the
post.