View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Jim Cone[_2_] Jim Cone[_2_] is offline
external usenet poster
 
Posts: 1,549
Default All Workbook Saved except This Workbook - Part2


If you start with 3 workbooks and close one of them, then workbook 3 doesn't exist any more.
Excel will try to find it and throw an error.

Good programming practice: Add "Option Explicit" as the first line in all modules.
It forces variable declaration.
'--
Sub Button2_Click()
Dim WB As Workbook
Dim SheetName As String
Dim FileExtStr As String
Dim FileFormatNum As Long

If Workbooks.Count 1 Then
For Each WB In Workbooks
If WB.Name < ThisWorkbook.Name Then
WB.Sheets(1).Activate
SheetName = WB.Name
FileExtStr = ".xls": FileFormatNum = 56
WB.SaveAs Filename:=SheetName & FileExtStr, _
FileFormat:=FileFormatNum
WB.Close SaveChanges:=True
End If
Next
Else
MsgBox "Only 1 Open File"
Exit Sub
End If
MsgBox "All Open Workbooks Saved and Closed"
End Sub
--
Jim Cone
Portland, Oregon USA
http://www.mediafire.com/PrimitiveSoftware

..
..
..

"Len"
wrote in message
...
Hi,
I tried to find another alternative codes to achieve the same result
with more efficient and time saving.
I decided to replace the following codes in the earlier post of "All
Workbooks Saved except This Workbook" with For Next Loop and it works
perfectly when there is only 2 excel files ( ie 1 open workbook plus
open workbook containing codes )

However, after working around several times and yet it fails with
error message " Subscript Out of Range" when there are more than 3
excel files ( ie 1 open workbook plus open workbook containing
codes )

Sub Button2_Click()
Dim WB As Workbook
Dim i As Long
For i = 1 To Workbooks.Count
If Workbooks.Count 1 Then
If (Workbooks(i).Name < ThisWorkbook.Name) Then <--------
Error " Subscript Out of Range"
With Workbooks(i)
.Sheets(1).Activate
SheetName = .ActiveSheet.Name
FileExtStr = ".xls": FileFormatNum = 56
.SaveAs Filename:=SheetName & FileExtStr, _
FileFormat:=FileFormatNum
.Close SaveChanges:=True
End With
End If

Else
MsgBox "Only 1 Open File"
Exit Sub
End If
Next
MsgBox "All Workbooks Saved under this Directory Folder "
End Sub

Any Helps will be much appreciated and thanks in advance
Regards
Len