的方法如下:
Sub SplitWorkbook()
Dim ws As Worksheet
Dim newWorkbook As Workbook
Dim newWorksheet As Worksheet
Dim lastRow As Long
Dim i As Long
' 获取主电子表格的工作表数量
Set ws = ThisWorkbook.Worksheets("主电子表格名称")
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' 创建新的工作簿
Set newWorkbook = Workbooks.Add
i = 1
' 循环遍历主电子表格的每一行
For Each cell In ws.Range("A2:A" & lastRow)
' 获取当前行的工作表名称
sheetName = cell.Value
' 检查新工作簿中是否已存在同名工作表,如果存在则跳过
On Error Resume Next
Set newWorksheet = newWorkbook.Worksheets(sheetName)
On Error GoTo 0
' 如果不存在同名工作表,则复制当前行的数据到新工作簿中
If newWorksheet Is Nothing Then
ws.Rows(cell.Row).Copy
' 在新工作簿中创建新的工作表,并将复制的数据粘贴到新工作表中
Set newWorksheet = newWorkbook.Worksheets.Add
newWorksheet.Name = sheetName
newWorksheet.Range("A1").PasteSpecial xlPasteAll
Application.CutCopyMode = False
' 调整新工作表的格式和布局
newWorksheet.Columns.AutoFit
newWorksheet.Rows.AutoFit
i = i + 1
End If
Next cell
' 保存新工作簿
newWorkbook.SaveAs "新工作簿的文件路径和名称.xlsx"
newWorkbook.Close
' 清理内存
Set newWorksheet = Nothing
Set newWorkbook = Nothing
Set ws = Nothing
MsgBox "拆分完成!"
End Sub
这种方法可以帮助你将主电子表格拆分为多个工作表,每个工作表保存在一个独立的工作簿中。这在需要将大型数据集分割为更小的部分以便于处理和共享时非常有用。
腾讯云相关产品和产品介绍链接地址:
领取专属 10元无门槛券
手把手带您无忧上云