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

 

[TheHack22]

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

@Fluff

This works perfectly now.Thank you so much. you're the best
Imran

 

[Fluff]

You're welcome & thanks for the feedback.