基于工作表VBA的名称将多个工作表添加到新的工作簿
这是我第一次在这里发表，所以如果我的问题不清楚，我表示歉意。 我有一个vba应用程序，目前采取我的工作簿中的所有可见的工作表，并为每个创build新的工作簿。 我需要改变这个，以便我可以添加多个工作表到同一个工作簿。
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”。 对不起，如果这是一个明显的答案。
非常感谢你，
吉米
在复制方法中，您可以指定要复制工作表的位置，否则将放置在新的工作簿中，在当前代码中就是这种情况。 只需将代码更改为： sh.copy after:=destwb.sheets(1) （注意：只有在您已经设置好destwb后才能使用，所以现在就复制第一张表格）。