Hi,

After several attempts, it fails to work correctly to save all opened
workbooks in a specific directory folder
It works fine when there are more than one excel files opened
However, in the event if there is no excel file being opened except
this workbook and prompt the message " All workbooks saved " based on
the following codes

Dim WB As Workbook
For Each WB In Workbooks
If Not WB Is Nothing Then
If WB.Name <> ThisWorkbook.Name Then
With WB
.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 "No Excel File is found"
Exit Sub
End If
Next

MsgBox "All Workbooks Saved under this Directory Folder "

Any helps will be much appreciated and thanks in advance

Regards
Len

Your code does not save/close all workbooks in a specific directory.
Your code saves/closes all OPEN workbooks except the workbook containing the code.
Add this before the start of the loop...

If Workbooks.Count = 1 Then
MsgBox "Only 1 workbook open"
Exit Sub
End If
--
Jim Cone
Portland, Oregon USA
http://www.contextures.com/excel-sort-addin.html

..
..
..

"Len" <(E-Mail Removed)>
wrote in message
news:e3cb90dc-8731-4772-a961-(E-Mail Removed)...
Hi,
After several attempts, it fails to work correctly to save all opened
workbooks in a specific directory folder
It works fine when there are more than one excel files opened
However, in the event if there is no excel file being opened except
this workbook and prompt the message " All workbooks saved " based on
the following codes

Dim WB As Workbook
For Each WB In Workbooks
If Not WB Is Nothing Then
If WB.Name <> ThisWorkbook.Name Then
With WB
.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 "No Excel File is found"
Exit Sub
End If
Next

MsgBox "All Workbooks Saved under this Directory Folder "

Any helps will be much appreciated and thanks in advance

Regards
Len

On Aug 11, 6:53*am, Len <ltong2000...@yahoo.co.uk> wrote:
> Hi,
>
> After several attempts, it fails to work correctly to save all opened
> workbooks in a specific directory folder
> It works fine when there are more than one excel files opened
> However, in the event if there is no excel file being opened except
> this workbook and prompt the message " All workbooks saved " based on
> the following codes
>
> Dim WB As Workbook
> *For Each WB In Workbooks
> * * If Not WB Is Nothing Then
> * * * * If WB.Name <> ThisWorkbook.Name Then
> * * * * With WB
> * * * *.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 "No Excel File is found"
> * * Exit Sub
> * * End If
> * * Next
>
> MsgBox "All Workbooks Saved under this Directory Folder "
>
> Any helps will be much appreciated and thanks in advance
>
> Regards
> Len

Here is one I have used for a long time that saves all and quits excel

Sub CLOSE_ALL()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In Application.Workbooks
If w.Name <> ThisWorkbook.Name Then
w.Save
End If
Next w
Application.Quit
End Sub

Hi Jim, Don

Thanks for your prompt reply and your codes

Yes, my codes is to saves/closes all OPEN workbooks except the
workbook containing the code.
After work around with your codes, it works great
Below is the revised codes

Sub Button1_Click()
Dim WB As Workbook
For Each WB In Workbooks
If Workbooks.Count > 1 Then
If WB.Name <> ThisWorkbook.Name Then
With WB
.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 workbook open"
Exit Sub
End If
Next

MsgBox "All Workbooks Saved under this Directory Folder "

End Sub

Thanks again

Cheers
Len