Loop and save all open MS Excel Files based on cell reference

[TheHack22]

Hi VBA experts.
I found this VBA code online to save all open workbooks (Except Thisworkbook-with the code) in a predefined location with the fileName based on Cell A2.
The issue is that Cell A2 (in the raw data files) has leading and trailing spaces and I needed to incorporate a CLEAN function into this code.
I'm getting a 'Run-time error '1004'. see red text below.

Can someone please help me with this?

Option Explicit
            Public ThisFile As String
            Public Path As String
           Sub CloseAndSaveOpenWorkbooks()
                Dim Wkb As Workbook
ThisFile = ActiveWorkbook.Sheets(1).Range("A2").Value ' Commented out as this piece of code was not working as intended **
                Path = "C:\Amplitude TOP LEVEL PAGES\Raw_Data\"
                With Application
                    .ScreenUpdating = False
                     '       Loop through the workbooks collection
                    For Each Wkb In Workbooks
                        With Wkb
                            If .Name <> ThisWorkbook.Name Then
                             '               if the book is read-only
                             '               don't save but close
                            If Not Wkb.ReadOnly Then
                          [B] [/B]    .SaveAs Filename:=(Path & ActiveWorkbook.Sheets(1).Range("A2").Value & ".xlsx"), FileFormat:=xlExcel8 '(line giving the error)
                             
                            End If
                             '               We save this workbook, but we don't close it
                             '               because we will quit Excel at the end,
                             '               Closing here leaves the app running, but no books
                                .Close
                            End If
                        End With
                    Next Wkb

                    .ScreenUpdating = True
                    ' .Quit 'Quit Excel
                End With
            End Sub

 

[Fluff]

Are you trying to save the files as xlsx, or xls?

 

[TheHack22]

Are you trying to save the files as xlsx, or xls?

@Fluff Thanks for your response. I'm trying to save as .xlsx

 

[Fluff]

Ok, try it like

Public ThisFile As String
Public Path As String
Sub CloseAndSaveOpenWorkbooks()
   Dim Wkb As Workbook
   ThisFile = ActiveWorkbook.Sheets(1).Range("A2").Value ' Commented out as this piece of code was not working as intended **
   Path = "C:\Amplitude TOP LEVEL PAGES\Raw_Data\"
   With Application
   .ScreenUpdating = False
   '       Loop through the workbooks collection
   For Each Wkb In Workbooks
      With Wkb
         If .Name <> ThisWorkbook.Name Then
         '               if the book is read-only
         '               don't save but close
         If Not Wkb.ReadOnly Then
         .SaveAs Path & Application.Trim(ThisFile) & ".xlsx", 51
         
         End If
         '               We save this workbook, but we don't close it
         '               because we will quit Excel at the end,
         '               Closing here leaves the app running, but no books
         .Close
         End If
      End With
   Next Wkb

.ScreenUpdating = True
' .Quit 'Quit Excel
End With
End Sub

 

[TheHack22]

Ok, try it like

Public ThisFile As String
Public Path As String
Sub CloseAndSaveOpenWorkbooks()
   Dim Wkb As Workbook
   ThisFile = ActiveWorkbook.Sheets(1).Range("A2").Value ' Commented out as this piece of code was not working as intended **
   Path = "C:\Amplitude TOP LEVEL PAGES\Raw_Data\"
   With Application
   .ScreenUpdating = False
   '       Loop through the workbooks collection
   For Each Wkb In Workbooks
      With Wkb
         If .Name <> ThisWorkbook.Name Then
         '               if the book is read-only
         '               don't save but close
         If Not Wkb.ReadOnly Then
         .SaveAs Path & Application.Trim(ThisFile) & ".xlsx", 51
        
         End If
         '               We save this workbook, but we don't close it
         '               because we will quit Excel at the end,
         '               Closing here leaves the app running, but no books
         .Close
         End If
      End With
   Next Wkb

.ScreenUpdating = True
' .Quit 'Quit Excel
End With
End Sub

@Fluff

Thanks very much for this code. I tried it and have two issues.

The Trim Function doesn't work. I changed it to CLEAN
It now works partially with this small tweak, but the issue now is that this only saves the first file. The others are closed without saving them.
Line changed ".SaveAs Path & Application.Trim(ThisFile) & ".xlsx", 51".

Any suggestion on how to deal with the new issue, that is, it's only saving one workbook and skipping the rest without saving?

Imran

 

[Fluff]

Remove this line

         .Close

otherwise it will close the workbook with the code as soon as it gets to it.

 

[TheHack22]

Remove this line

         .Close

otherwise it will close the workbook with the code as soon as it gets to it.

@Fluff

This is the new error (Run-Time 1004) after I removed ".Close"

 

[Fluff]

That means what it says. What should happen in that situation?

 

[TheHack22]

That means what it says. What should happen in that situation?

I cleared the folder, before running my code. Not sure what's the reason for this.
Imran

 

[Fluff]

That's my fault, try it like

Sub CloseAndSaveOpenWorkbooks()
   Dim Wkb As Workbook
   Path = "C:\Amplitude TOP LEVEL PAGES\Raw_Data\"
   With Application
   .ScreenUpdating = False
   '       Loop through the workbooks collection
   For Each Wkb In Workbooks
      With Wkb
         If .Name <> ThisWorkbook.Name Then
         '               if the book is read-only
         '               don't save but close
         If Not Wkb.ReadOnly Then
            ThisFile = Application.Clean(Wkb.Sheets(1).Range("A2").Value)
            .SaveAs Path & Application.Trim(ThisFile) & ".xlsx", 51
         
         End If
         '               We save this workbook, but we don't close it
         '               because we will quit Excel at the end,
         '               Closing here leaves the app running, but no books
'         .Close
         End If
      End With
   Next Wkb

.ScreenUpdating = True
' .Quit 'Quit Excel
End With
End Sub