Please help with code! Thanks!

[Damil4real]

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!

Thanks!

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
' Following line will prevent all saving
Cancel = True
' Following line will prevent the Save As Dialog box from
showing
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()

Cells.Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Range("A1").Select

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

ActiveWindow.Close
Range("D1").Select

MsgBox "File saved!"

End Sub

 

[Dave Peterson]

Maybe...

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 _
(after:=.Worksheets(.Worksheets.Count))
End With
wks.Cells.Copy
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!"
Else
Application.DisplayAlerts = False
NewWkbk.Worksheets("deletemelater").Delete
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!"
Else
On Error Resume Next
NewWkbk.SaveAs Filename:=myFileName, FileFormat:=xlWorkbookNormal
If Err.Number <> 0 Then
MsgBox "Not saved!" & vbLf & Err.Description
Err.Clear
Else
NewWkbk.Close savechanges:=False
MsgBox "Saved"
End If
On Error GoTo 0
End If
End If

End Sub