ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   All Workbook Saved except This Workbook - Part2 (https://www.excelbanter.com/excel-programming/443499-all-workbook-saved-except-workbook-part2.html)

Len

All Workbook Saved except This Workbook - Part2
 
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[_2_]

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

Jim Cone[_2_]

All Workbook Saved except This Workbook - Part2
 
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
--
Jim Cone
Portland, Oregon USA


Len

All Workbook Saved except This Workbook - Part2
 
Hi Jim,

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

Regards
Len


All times are GMT +1. The time now is 10:35 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com