从选定的工作表中保存新工作簿

Question

所以我的主要目标是将工作表（取决于它们是否被首页上的复选框选中）保存到新工作簿。

我有 6 张工作表，所以我的首页/工作表上有 6 个不同的复选框。

这是我尝试过的示例代码（注意：这仅显示检查 1 个复选框，但我需要 6 个复选框）：

Sub saveSheetWorkbook()

Dim exampleName As Variant
Dim exampleSavePath As String
Dim exampleSheet As Variant

exampleName = InputBox("Who will this be sent to?")

exampleSavePath = ActiveWorkbook.Path & "\" & exampleName

If Worksheets("Example Worksheet 1").Range("E29") = True Then
exampleSheet = "Example Worksheet 2"
End If

Sheets(Array("Example Worksheet 1"), exampleSheet).Copy
ActiveWorkbook.SaveAs Filename:=exampleSavePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

End Sub

例如，我想始终保存示例工作表 1，但仅在选中复选框时才保存示例工作表 2（和 3、4、5、6）。示例工作表 1 中的单元格 E29 是复选框的链接单元格。

所以这个宏在勾选复选框时有效，但是当取消勾选复选框时，我得到一个错误。

我已对其进行设置，以便工作表数组包含名称或不包含任何内容。但是当不包含任何内容时，这会给我带来错误。

任何帮助都会很棒。

Answer 1

替换这个：

If Worksheets("Example Worksheet 1").Range("E29") = True Then
    exampleSheet = "Example Worksheet 2"
End If
Sheets(Array("Example Worksheet 1"), exampleSheet).Copy

有了这个：

If Worksheets("Example Worksheet 1").Range("E29") = True Then
    exampleSheet = "Example Worksheet 2"
    Sheets(Array("Example Worksheet 1", exampleSheet)).Copy
Else
    Sheets("Example Worksheet 1").Copy
End If

Answer 2

你可能想像下面这样（见 cmets）：

Option Explicit

Sub saveSheetWorkbook()
    Dim exampleSavePath As String
    Dim sheetsArr As Variant, linkedCellsArr As Variant
    Dim toBeCopiedSheetsNames As String
    Dim iElem As Long

    linkedCellsArr = Array("E29", "E30", "E31") '<--| list your linked cells addresses
    sheetsArr = Array("Example Worksheet 2", "Example Worksheet 3", "Example Worksheet 4") '<--| list your worksheets in corresponding order to linkedcells

    toBeCopiedSheetsNames = "Example Worksheet 1" '<--| put "Example Worksheet 1" worksheet in the worksheets to be copied list for sure
    For iElem = LBound(linkedCellsArr) To UBound(linkedCellsArr) '<--| loop through linked cells (addresses array)
        If Range(linkedCellsArr(iElem)) Then toBeCopiedSheetsNames = toBeCopiedSheetsNames & "|" & sheetsArr(iElem) '<-- if TRUE then add corresponding worksheet name to the worksheet to be copied list
    Next iElem

    exampleSavePath = ActiveWorkbook.Path & "\" & Application.InputBox("Who will this be sent to?", Type:=2) '<--| retrieve the file name and build its "full" name

    Sheets(Split(toBeCopiedSheetsNames, "|")).Copy '<--| copy worksheets whose name is listed in 'toBeCopiedSheetsNames'
    ActiveWorkbook.SaveAs Filename:=exampleSavePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub