☰

VBA 将仅可见工作表保存为工作簿

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 vba microsoft-excel-2007
VBA 将仅可见工作表保存为工作簿

我正在使用以下 VBA（附在下面）。它工作得很好，我最喜欢的是它与路径/名称无关。我现在正尝试保存基于一些 HiddenSheets（非常隐蔽）的多个报告，我不想包含这些报告。这个宏的问题在于它为每个工作表（包括不可见的工作表）创建单独的工作表。是否有机会使用相同的概念来创建具有相同工作簿名称的文件夹，但仅包含可见的工作表？如果是这样，请告诉我。我一直在尝试调整此代码，它要么只包含一个工作表，要么包含所有工作表（而不仅仅是可见的工作表）谢谢！

Sub SaveShtsAsBook()
    Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
    MyFilePath$ = ActiveWorkbook.Path & "\" & _
    Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         '      End With
        On Error Resume Next '<< a folder exists
        MkDir MyFilePath '<< create a folder
        For N = 1 To Sheets.Count
            Sheets(N).Activate
            SheetName = ActiveSheet.Name
            Cells.Copy
            Workbooks.Add (xlWBATWorksheet)
            With ActiveWorkbook
                With .ActiveSheet
                    .Paste
                    .Name = SheetName
                    [A1].Select
                End With
                 'save book in this folder
                .SaveAs Filename:=MyFilePath _
                & "\" & SheetName & ".xlsx"
                .Close SaveChanges:=True
            End With
            .CutCopyMode = False
        Next
    End With
    Sheet1.Activate
End Sub

答案1

隐藏的工作表可以是 xlSheetHidden (0) 或 xlSheetVeryHidden (2)，而可见的工作表只能是 xlSheetVisible (-1)。您可以检查工作表.Visible 属性并确定是否要继续。

作为一种快捷方式，如果您复制工作表而不提供目标，那么您将使用单个工作表创建原始工作簿的新副本。

Option Explicit

Sub SaveShtsAsBook()
    Dim Sheet As Worksheet, MyFilePath As String, w As Long

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    On Error Resume Next '<< a folder exists

    'define the workbook
    With ThisWorkbook

        MyFilePath = Left(.FullName, InStrRev(.FullName, ".") - 1)
        MkDir MyFilePath '<< create a folder

        For w = 1 To .Worksheets.Count

            'check if worksheet is visible
            If .Worksheets(w).Visible = xlSheetVisible Then

                .Worksheets(w).Copy   'create new active workbook with copy of worksheet

                With ActiveWorkbook
                    .Worksheets(1).Cells(1, "A").Select
                     'save book in this folder. Use FileFormat argument instead of adding .XLSX
                    .SaveAs Filename:=MyFilePath & "\" & .Worksheets(1).Name, FileFormat:=xlOpenXMLWorkbook
                    'close saving changes
                    .Close SaveChanges:=True
                End With

            End If

        Next w

    End With

    Sheet1.Activate

End Sub

答案2

跳过床单Worksheets("Sheet1").visible = False

相关内容