All Workbook Saved except This Workbook - Part2

[Len]

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

 

[Jim Cone]

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" <[email protected]>
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

 

[Jim Cone]

Further...

When deleting items from a collection, it is usually best to work backwards, from the end back to the start.
Your code should work as is just by changing...
For i = 1 To Workbooks.Count
-to-
For i = Workbooks.Count to 1 Step -1

 

[Len]

Hi Jim,

Thanks for your advice and your codes
After amending the codes and run it, Great !, it works perfectly

Regards
Len