根据工作表VBA的名称将多个工作表添加到新工作簿

Question

这是我第一次在这里发帖，所以如果我的问题不清楚，我深表歉意。 我有一个 vba 应用程序，它目前在我的工作簿中获取所有可见的工作表，并为每个工作簿创建新的工作簿。我需要对此进行更改，以便可以将多个工作表添加到同一个工作簿。

ActiveWorkbook.Sheets(1).Visible = False
ActiveWorkbook.Sheets(2).Visible = False

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Set Sourcewb = ThisWorkbook

'Create new folder to save the new files in
FolderName = Sourcewb.path & "\Tracker Workbooks"

'Copy every visible sheet to a new workbook
For Each sh In Sourcewb.Worksheets

    'If the sheet is visible then copy it to a new workbook
    If sh.Visible = -1 Then
        sh.Copy

        'Set Destwb to the new workbook
        Set Destwb = ActiveWorkbook

        'Determine the Excel version and file extension/format
        With Destwb
            If Sourcewb.Name = .Name Then
                MsgBox "Your answer is NO in the security dialog"
                GoTo GoToNextSheet
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End With

        Application.DisplayAlerts = False

        'Save the new workbook and close it
        With Destwb
            .SaveAs FolderName & "\" & Destwb.Sheets(1).Name & FileExtStr,    FileFormat:=FileFormatNum
            .Close False
        End With
        Application.DisplayAlerts = True
    End If
GoToNextSheet:
Next sh

MsgBox "You can find the files in " & FolderName

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

ActiveWorkbook.Sheets(1).Visible = True
ActiveWorkbook.Sheets(2).Visible = True
End Sub

一些给定的代码是复制/粘贴的，但自去年夏天以来我就没有参与过这个项目，所以我不清楚我自己写了哪些部分。

无论如何，我可以有一个工作表“12345”，我会为其创建一个新工作簿并将工作表复制到该工作簿，然后将工作簿命名为“12345”。如果我有工作表“54321-1”和“54321-2”，我需要将它们都复制到名为“54321”的同一个工作簿中，其中包含两个名为“54321-1”和“54321-2”的工作表选项卡。目前，它将制作 2 个单独的工作簿：“54321-1”和“54321-2”。对不起，如果这是一个明显的答案。

谢谢你，

吉米

Answer 1

在Copy method 中，您可以指定要将工作表复制到哪里，否则它将被放置在新的工作簿中，这就是您当前代码的情况。只需将代码更改为：sh.copy after:=destwb.sheets(1) （注意：它只有在您已经设置 destwb 后才能工作，所以现在复制第一张表）。