Vba 使用对话框选择工作表并将其作为值复制到新工作簿

我想编写一段代码，允许用户在打开的工作簿中选择一些工作表，并将它们作为值复制到另一个工作簿中，该工作簿保存在与原始工作簿相同的位置，但用户未指定其他名称。我是VBA的一个相对较新的用户，但以前有过一些编程经验

我已经成功地编写了代码，生成了一个对话框，其中根据工作簿中的工作表填充了复选框，并创建了一个新文件并将其保存在适当的位置

然而，我在循环浏览选定的表单，并将它们作为值复制粘贴到新书中时遇到了一些问题。打开新创建的工作簿时，它是空的。因此，复制/粘贴似乎不起作用

该代码最初基于我在网上找到的代码，用于选择任何纸张并打印它们。如能对以下代码有所了解，将不胜感激。我包括了额外的代码，以防其中有一些潜在的问题阻止以后的代码工作

Sub CreateCirculationCopy()

    Dim CurrentSheet As Worksheet
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim i As Integer
    Dim TopPos As Integer
    Dim SheetCount As Integer
    Dim SelectDlg As DialogSheet
    Dim cb As CheckBox
    Dim Current As String
    Dim x As Integer

    Application.ScreenUpdating = False

    'Add a temp dialog sheet
    Set CurrentSheet = ActiveSheet
    Set SelectDlg = ActiveWorkbook.DialogSheets.Add

    SheetCount = 0

    'Add the checkboxes
    TopPos = 40
    For i = 1 To ActiveWorkbook.Worksheets.Count
        Set CurrentSheet = ActiveWorkbook.Worksheets(i)
        'Skip empty and hidden sheets
        If CurrentSheet.Visible Then
            SheetCount = SheetCount + 1
            SelectDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
                SelectDlg.CheckBoxes(SheetCount).Text = _
                CurrentSheet.Name
            TopPos = TopPos + 13
        End If
    Next i

    'Format dialog box
    SelectDlg.Buttons.Left = 240
    With SelectDlg.DialogFrame
        .Height = Application.Max _
            (68, SelectDlg.DialogFrame.Top + TopPos - 34)
        .Width = 230
        .Caption = "Select sheets to copy"
    End With
    SelectDlg.Buttons("Button 2").BringToFront
    SelectDlg.Buttons("Button 3").BringToFront

    'Display the dlg box
    Set wb = Workbooks.Add
    x = 1
    Application.DisplayAlerts = False
    CurrentSheet.Activate
    Application.ScreenUpdating = True
    If SheetCount <> 0 Then
        If SelectDlg.Show Then
            For Each cb In SelectDlg.CheckBoxes
                If cb.Value = x10n Then
                Worksheets(cb.Caption).Activate
                ActiveSheet.Cells.Copy
                'ActiveSheet.UsedRange.Copy
                Windows(wb).Activate
                wb.Sheets("Sheet" & x).Activate
                ActiveSheet.Cells("A1").PasteSpecial xlPasteValues, _
                        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Workbooks(1).Activate
                Worksheets(cb.Caption).Activate
                x = x + 1
                End If
            Next cb
        End If
    Else
        MsgBox "All worksheets are empty"
    End If

    Filename = ThisWorkbook.Path & "\" & "Circulation.xlsx"
    wb.SaveAs Filename, XlFileFormat.xlOpenXMLWorkbook
    wb.Close

    SelectDlg.Delete
    Application.DisplayAlerts = True
    CurrentSheet.Activate


End Sub

使用DialogSheet很有趣，但更简单的方法是使用listbox创建userform并允许用户multiselect ListBox1.multiselect=FMMultiSelect Multi

但这并不重要：

使用您的，我有一个问题，如果cb.Value=x10n，那么x10n等于空

第二个问题是Windowswb.Activate，wb它是一个对象，我使用Windowswb.Name.Activate

我在复制时遇到问题：ActiveSheet.CellsA1.pasteValues，Operation:=xlNone，SkipBlanks:=False，Transpose:=False

我将其更改为Selection.paste特殊xlPasteValues，操作：=xlNone，SkipBlanks:=False，转置：=False

代码的一部分，稍作修改：

    If SelectDlg.Show Then
        For Each cb In SelectDlg.CheckBoxes
            If cb.Value = 1 Then
            Worksheets(cb.Caption).Activate
            ActiveSheet.Cells.Copy
            Windows(wb.Name).Activate
            wb.Sheets("S" & x).Activate
            Selection.PasteSpecial xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Workbooks(1).Activate
            Worksheets(cb.Caption).Activate
            x = x + 1
            End If
        Next cb
    End If

---

让我知道它是否有效

Hi Dawid，我确实尝试使用userform，但我发现使用动态信息生成对话框更容易。这些改变很有帮助，非常感谢。我只需要稍微修改一下我的代码，直到得到我想要的结果。我完成后会发布代码。