将Excel工作表分成多个工作簿

我有一个Excel文件与多个表。 我想将其分成单独的文件，每个文件3张。

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

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

我怎样才能把纸张从一张复印到另一张呢？

Answer 1

这个代码将会

• 将您的工作簿一次分成3个批次的新工作簿，
• 将它们保存为下面命名的新文件
• closures它们

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

代码将用额外的工作表“填充”Excel文件，以保持3页拆分多个部分。

请注意，您可以使用.Copy创build新的工作簿 – 无需使用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 

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