将“两个特定工作表”复制到新工作簿中

Question

当我们有一个包含多张工作表的工作簿时

sheet_1, sheet_2, ..., sheet_n, sheet_constant

我们喜欢用两张成对的工作表创建 n 个工作簿

workbook 1: sheet_1, sheet_constant
workbook 2: sheet_2, sheet_constant
...
workbook n: sheet_n, sheet_constant

我们如何用 vba 做到这一点？

我知道我们可以用这个复制一张纸

Sub CopySheet()
  ThisWorkbook.Sheets("sheet_1").Copy
  Application.Dialogs(xlDialogSaveAs).Show
End Sub

我试过这个没有成功

Sub CopySheets()
  ThisWorkbook.Sheets("sheet_1").Copy
  ThisWorkbook.Sheets("sheet_constant").Copy
  Application.Dialogs(xlDialogSaveAs).Show
End Sub

Answer 1

你可以使用：

Sub CopySheets(VariableSheetName As String, ConstantSheetName As String)
    ThisWorkbook.Sheets(Array(VariableSheetName, _
                              ConstantSheetName)).Copy
    Application.Dialogs(xlDialogSaveAs).Show
End Sub

注意：同时复制两张工作表的好处是，工作表之间的任何引用都不会突然变成原始工作簿的链接，如果您一个接一个地复制工作表，就会发生这种情况。

这个子程序可以这样调用：

CopySheets "sheet_1", "sheet_constant"
CopySheets "sheet_2", "sheet_constant"
CopySheets "sheet_3", "sheet_constant"

或循环（假设您的工作表中确实有数字）

For i = 1 To 3
    CopySheets "sheet_" & i, "sheet_constant"
Next

或者，如果您想要复制所有工作表：

For Each ws in Worksheets
    If ws.Name <> "sheet_constant" Then
        CopySheets ws.Name, "sheet_constant"
    End If
Next

Answer 2

基于@YowE3K 的回答，这个更通用一点，并且有自动保存选项。

Sub CopySheets()
    Dim ws As Worksheet
    ChDir (ThisWorkbook.Path)
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name = "sheet_constant" Then GoTo NextIteration
        ThisWorkbook.Sheets(Array(ws.Name, "sheet_constant")).Copy
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        ActiveWorkbook.SaveAs Filename:=ws.Name, FileFormat:=xlNormal, CreateBackup:=False
        ActiveWorkbook.Saved = True
        ActiveWindow.Close
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
NextIteration:
    Next ws

End Sub