excel - 将 Excel 工作表拆分为多个工作簿

Question

我有一个包含多个工作表的 Excel 文件。我想将其拆分为单独的文件，每个文件 3 张。

我创建了一个新的工作簿，如下所示：

Set NewBook = Workbooks.Add
With NewBook
     .Title = "File1"
     .Subject = "File1"
     .SaveAs FileName:="File1.xls"
End With

如何将工作表从一张复制到另一张？

Answer 1

这段代码将

• 一次将您的工作簿拆分为每批 3 张的新工作簿，
• 将它们保存为具有以下命名的新文件
• 关闭它们

File1 （前 3 张）
File4（第 4-6 页）
File7（第 7-9 页）

该代码将用额外的表格“填充” Excel 文件，以保持 3 张拆分多张。

请注意，您可以使用创建新工作簿.Copy- 无需使用Workbooks.Add

Code to be run from the Workbook to be split

Sub BatchThree()
    Dim lngSht As Long
    Dim lngShtAdd As Long
    Dim lngShts As Long
    Dim bSht As Boolean
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    lngSht = 1

    'pad extra sheets
    If ThisWorkbook.Sheets.Count Mod 3 <> 0 Then
        bSht = True
        lngShts = ThisWorkbook.Sheets.Count Mod 3
        For lngShtAdd = 3 To (lngShts + 1) Step -1
            ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(Sheets.Count)
        Next
    End If

    Do While lngSht + 2 <= ThisWorkbook.Sheets.Count
        Sheets(Array(lngSht, lngSht + 1, lngSht + 2)).Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "/File" & lngSht
        ActiveWorkbook.Close False
        lngSht = lngSht + 3
    Loop

    'remove extra sheets
    If bSht Then
     For lngShtAdd = 3 To (lngShts + 1) Step -1
            ThisWorkbook.Sheets(Sheets.Count).Delete
        Next
    End If

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
End Sub

Answer 2

制作副本的基本语法（如果这是您的问题）：

Sub Make_Copy()
Thisworkbook.Sheets(1).Copy _
   after:=SomeWorkbook.Sheets(1)
End Sub

在复制旁边，自然也可以移动工作表。您可以在之前而不是之后复制并更改工作表的名称。