将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（sheets 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 

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