VBA: Auto save&close out of all current workbooks

2019-08-19 18:39发布

I'm trying to close all currently open Workbooks except for my Macro workbook, and .SaveAs my path, but I want my path to be a specified cell within my macro workbook [D1] to be precise. I also want the file name to be saved as cell A1 in the Workbook that I'm currently saving and closing out of. Now I'm stuck. I've listed the code that I'm utilizing currently, and the issue I'm running into with this piece of code is that it's saving as the name in cell A1 in the currently selected Workbook vs the Workbook the code is currently cycling on. I hope this makes sense.

            Option Explicit
            Public ThisFile As String
            Public Path As String

            Sub CloseAndSaveOpenWorkbooks()
                Dim Wkb As Workbook
                ' ThisFile = ActiveWorkbook.Sheets(1).Range("A1").Value ** Commented out as this piece of code was not working as intended **
                Path = "C:\Users\uuis\Desktop"

                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 Filename:=(Path & "\" & ActiveWorkbook.Sheets(1).Range("A1").Value & ".xls"), FileFormat:=xlExcel8

                            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

1条回答
仙女界的扛把子
2楼-- · 2019-08-19 19:04
ActiveWorkbook.Sheets(1).Range("A1").Value

should be

Wkb.Sheets(1).Range("A1").Value
查看更多
登录 后发表回答