Question

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

sheet_1, sheet_2, ..., sheet_n, sheet_constant

我们希望创建两个成对的工作簿

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

您可以使用：

<preference name="Orientation" value="all" />

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

此子程序可以称为：

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

Answer 2

根据@ YowE3K的答案，这个是一个更通用的，有一个autoSave选项。

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

复制＆＃34;两张特定的表格＆＃34;进入一个新的工作簿

2 个答案: