VBA。仅将可见工作表导出到单个工作簿

Question

Sub SaveShtsAsBook() 
    ‘Select all visible and hide sheet’
    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 

我有一个工作簿，其中包含许多可见和隐藏的工作表。我只想将每个可见工作表导出到单个工作簿。上面的当前代码可以导出工作簿中的所有工作表，但之后我必须逐个删除它们。希望能解释我的情况。

Answer 1

您需要添加到代码中以排除隐藏工作表只是一个简单的If..Then statement 来检查Worksheet.Visible property 是True 还是False。

If Not yourWorsheet.Visible Then... ...然后您跳过该工作表。

---

以下过程是您尝试完成的更简单的整体方法...

将可见工作表导出到自己的工作簿：

如果 Before 和 After 均未指定，worksheet.Copy method 将创建一个新工作簿。

Sub saveVisibleSheetsAsXLSM()       'saves all visible sheets as new xlsx files
    Const exportPath = "x:\yourDestinationPath\"
    Dim ws As Worksheet, wbNew As Workbook
    For Each ws In ThisWorkbook.Sheets                      'for each worksheet
        If ws.Visible Then                                  'if it's visible:
            Debug.Print "Exporting: " & ws.Name
            ws.Copy '(if no params specified, COPY creates + activates a new wb)
            Set wbNew = Application.ActiveWorkbook          'get new wb object
            wbNew.SaveAs exportPath & ws.Name & ".xlsm", 52 'save new wb
            wbNew.Close                                     'close new wb
            Set wbNew = Nothing                             'cleanup 
        End If
    Next ws
    Set ws = Nothing                                        'clean up 
End Sub

Worksheet.Copy备注：

如果您没有指定Before 或After，Microsoft Excel 将创建一个新的workbook，其中包含包含复制的Worksheet 对象的复制工作表对象。新创建的工作簿拥有Application.ActiveWorkbook Property (Excel) 属性并包含一个工作表。单个工作表保留源工作表的Worksheet.Name Property (Excel) 和Worksheet.CodeName Property (Excel) 属性。如果复制的工作表包含 VBA 项目中的工作表代码表，则该代码表也会被携带到新工作簿中。

可以以类似的方式将多个工作表的数组选择复制到新的空白Workbook Object (Excel) 对象。

_{（来源：Documentation）}