PDA

View Full Version : Solved: Modify code to only save one worksheet in workbook



av8tordude
01-25-2008, 07:00 PM
Because the data entered into the worksheets belong to the Users, How can I modify this code to only save a specific worksheet in the workbook. I have a workbook with 7 sheets, but I only want the second sheet called "Logbook" to be saved, but the other worksheets deleted.


Option Explicit

PrivateSub Workbook_Open()
Dim StartTime#, CurrentTime#

'*****************************************
'SET YOUR OWN TRIAL PERIOD BELOW
'Integers (1, 2, 3,...etc) = number of days use
'1/24 = 1Hr, 1/48 = 30Mins, 1/144 = 10Mins use

Const TrialPeriod# = 30 '< 30 days trial

'set your own obscure path and file-name
Const ObscurePath$ = "C:\"
Const ObscureFile$ = "TestFileLog.Log"
'*****************************************

If Dir(ObscurePath & ObscureFile) = Empty Then
StartTime = Format(Now, "#0.#########0")
Open ObscurePath & ObscureFile ForOutputAs #1
Print #1, StartTime
Else
Open ObscurePath & ObscureFile ForInputAs #1
Input #1, StartTime
CurrentTime = Format(Now, "#0.#########0")
If CurrentTime < StartTime + TrialPeriod Then
Close #1
Exit Sub
Else
If [A1] <> "Expired" Then
MsgBox "Sorry, your trial period has expired - your data" & vbLf & _
"will now be extracted and saved for you..." & vbLf & _
"" & vbLf & _
"This workbook will then be made unusable."
Close #1
SaveShtsAsBook
[A1] = "Expired"
ActiveWorkbook.Save
Application.Quit
ElseIf [A1] = "Expired" Then
Close #1
Application.Quit
EndIf
EndIf
EndIf
Close #1
End Sub

Sub SaveShtsAsBook()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.Path & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
On Error Resume Next'<< a folder exists
MkDir MyFilePath '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
'//N.B. to remove all the cell formulas,
'//uncomment the 4 lines of code below...
'With Cells
'.Copy
'.PasteSpecial Paste:=xlPasteValues
'End With
.Name = SheetName
[A1].Select
End With
'save book in this folder
.SaveAs Filename:=MyFilePath _
& "\" & SheetName & ".xls"
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Open MyFilePath & "\READ ME.log" ForOutputAs #1
Print #1, "Thank you for trying out this product."
Print #1, "If it meets your requirements, visit"
Print #1, "http://www.xxxxx/xxxx to purchase"
Print #1, "the full (unrestricted) version..."
Close #1
End Sub

av8tordude
01-25-2008, 09:44 PM
Any help with this...this code is nice to use. Just wish I could get help in modifying this code to save only one of the sheets and delete the rest since the rest of the sheets the users don't enter any of their data in it.:banghead: :help

mikerickson
01-25-2008, 11:44 PM
This will delete all sheets except LogBook (This is caps sensitive)

Dim oneSheet As Worksheet
Application.DisplayAlerts = False
With ThisWorkbook
For Each oneSheet In .Sheets
oneSheet.Visible = xlSheetVisible
If oneSheet.Name <> "LogBook" And 1 < .Sheets.Count Then oneSheet.Delete
Next oneSheet
End With
Application.DisplayAlerts = True

You might consider using the CodeName of the sheet rather than the Name.

av8tordude
01-26-2008, 07:49 AM
This will delete all sheets except LogBook (This is caps sensitive)

Dim oneSheet As Worksheet
Application.DisplayAlerts = False
With ThisWorkbook
For Each oneSheet In .Sheets
oneSheet.Visible = xlSheetVisible
If oneSheet.Name <> "LogBook" And 1 < .Sheets.Count Then oneSheet.Delete
Next oneSheet
End With
Application.DisplayAlerts = True

You might consider using the CodeName of the sheet rather than the Name.

The code erase all the worksheets, including the Logbook sheet. The only sheet thats I see is sheet three. I tested this code on a new file and changed the name of one of the sheets to Logbook and ran the code. Sheet3 is the only sheet I see.

tpoynton
01-26-2008, 08:04 AM
This will delete all sheets except LogBook (This is caps sensitive)

Logbook <> LogBook

av8tordude
01-26-2008, 08:15 AM
Bump.duplicate post

av8tordude
01-26-2008, 08:20 AM
Logbook <> LogBook

Sir, could you clarify. I assume your talking about this part of the code..

If oneSheet.Name <> "LogBook" And 1 < .Sheets.Count Then oneSheet.Delete

tpoynton
01-26-2008, 08:36 AM
yep; be sure that what is in quotes exactly matches the name of the sheet as presented in the tab. if that doesnt work, post a sample workbook if you can.

av8tordude
01-26-2008, 09:19 AM
yep; be sure that what is in quotes exactly matches the name of the sheet as presented in the tab. if that doesnt work, post a sample workbook if you can.

Ok, I fix the problem, but when I change my computer date and a day ahead to test it, it closes the workbook, but it does delete all the worksheets except the Logbook worksheet, but it doesn't save the workbook like the original code I posted. The original code, took all the worksheets and disable all the formulas and macros and save the worksheets in a folder (confused? Look at the original code, then you'll see what I'm talking about.) I like that it disable the formulas and code, but, since the "logbook" sheet is the only sheet that has the user data on it, I want the code to save only that worksheet with all formula and macro disabled. I have a kill formula that will kill the trial workbook from their computer.

tpoynton
01-26-2008, 09:59 AM
put the bit to delete the sheets right before you do the saveas

av8tordude
02-14-2008, 07:42 AM
Dim oneSheet As Worksheet
Application.DisplayAlerts = False
With ThisWorkbook
For Each oneSheet In .Sheets
oneSheet.Visible = xlSheetVisible
If oneSheet.Name <> "Logbook" And 1 < .Sheets.Count Then oneSheet.Delete
Next oneSheet
End With


I get this error...

Run-time error '1004':
Method 'Delete' of object'_Worksheet' failed

oneSheet.Delete is highlighted as being the error. The error is caused by the workbook (not worksheets) being password protected. how can I resolve this problem to get around the protection so the worksheets are deleted?