的问题,可以通过以下步骤来实现:
Sub SplitWorkbook()
Dim wb As Workbook
Dim ws As Worksheet
Dim newWb As Workbook
Dim newWs As Worksheet
Dim i As Integer
Dim j As Integer
Dim sheetCount As Integer
Set wb = ThisWorkbook
sheetCount = wb.Sheets.Count
' 计算需要创建的新工作簿数量
Dim newWbCount As Integer
newWbCount = sheetCount / 4
If sheetCount Mod 4 <> 0 Then
newWbCount = newWbCount + 1
End If
' 拆分工作簿
For i = 1 To newWbCount
' 创建新的工作簿
Set newWb = Workbooks.Add
j = 1
' 将每4个工作表复制到新的工作簿
While j <= 4 And (i - 1) * 4 + j <= sheetCount
Set ws = wb.Sheets((i - 1) * 4 + j)
ws.Copy after:=newWb.Sheets(newWb.Sheets.Count)
j = j + 1
Wend
' 删除新工作簿中多余的工作表
For Each newWs In newWb.Sheets
If newWs.Index > 4 Then
Application.DisplayAlerts = False
newWs.Delete
Application.DisplayAlerts = True
End If
Next newWs
' 保存新工作簿
newWb.SaveAs "路径\文件名" & i & ".xlsx" ' 替换为你想要保存的路径和文件名
newWb.Close
Next i
End Sub
这个VBA代码可以将一个工作簿拆分为每4个工作表的新工作簿。它通过循环遍历工作表,并将每4个工作表复制到一个新的工作簿中。然后,它删除新工作簿中多余的工作表,并将新工作簿保存在指定的路径中。
这个方法适用于需要将大型工作簿拆分为多个较小工作簿的情况,例如将数据分发给不同的团队或将工作簿按照某种方式进行组织和管理。
腾讯云相关产品和产品介绍链接地址:
领取专属 10元无门槛券
手把手带您无忧上云