Question

我有一个包含多个表格的Excel文件。我想把它拆分成单独的文件，每个文件有3张。

我按如下方式创建了一个新的WorkBook：

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

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

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

2 个答案: