Please help with code! Thanks!



I have a workbook of about 26 worksheets. Since it’s pretty big, I
disabled the save & saveas so the user can only save the current sheet
(the current sheet is copied to another workbook) and the user is
given an option to saveas (saveas dialog) pops up.

The Private Sub Workbook is in the Workbook while the Sub SavingFile
is in the module. The code works well because most of the time, there
is only one visible sheet, so the code copies the one sheet to another
workbook for saving.

The problem is that sometimes, the visible sheets are more than one
sheet. In cases where there are more than one sheets visible, I want
the macro to be able to copy all visible sheets to another workbook
and pop up a saveas dialog so the user can still select what to name
the file.

The code I have right now is pasted below. The Private Sub Workbook is
in the Workbook while the Sub SavingFile is in the module.

I appreciate your assistance!



Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
' Following line will prevent all saving
Cancel = True
' Following line will prevent the Save As Dialog box from
If SaveAsUI Then SaveAsUI = False

Response = MsgBox(prompt:="Select 'Yes to Save File' or 'No to
Cancel'.", Buttons:=vbYesNo)
If Response <> vbYes Then Exit Sub

Call SavingFile

End Sub


Sub SavingFile()

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False

ActiveWorkbook.SaveAs Filename:= _
Application.GetSaveAsFilename(FileN, filefilter:="Excel Files


MsgBox "File saved!"

End Sub

Dave Peterson


Option Explicit
Sub SavingFile()

Dim sh As Worksheet
Dim NewWkbk As Workbook
Dim wks As Worksheet
Dim newWks As Worksheet
Dim myFileName As Variant
Dim FileN As String

Set NewWkbk = Workbooks.Add(1)
NewWkbk.Worksheets(1).Name = "Deletemelater"

For Each wks In ThisWorkbook.Worksheets
If wks.Visible = xlSheetVisible Then
With NewWkbk
Set newWks = .Worksheets.Add _
End With
With newWks.Range("A1")
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormats
End With
End If
Next wks

If NewWkbk.Worksheets.Count = 1 Then
NewWkbk.Close savechanges:=False
MsgBox "No worksheets copied!"
Application.DisplayAlerts = False
Application.DisplayAlerts = True

FileN = "C:\somefilename.xls" 'not sure where this comes from
myFileName = Application.GetSaveAsFilename(InitialFileName:=FileN, _
filefilter:="Excel Files,*.xls")

If myFileName = False Then
'user hit cancel, what should happen
MsgBox "New File wasn't saved or closed!"
On Error Resume Next
NewWkbk.SaveAs Filename:=myFileName, FileFormat:=xlWorkbookNormal
If Err.Number <> 0 Then
MsgBox "Not saved!" & vbLf & Err.Description
NewWkbk.Close savechanges:=False
MsgBox "Saved"
End If
On Error GoTo 0
End If
End If

End Sub

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question