excel每隔几列拆分为工作簿，VBA如何操作？

Question

如图所示，此excel表中有超多组数据，每组数据都是5列，但行数未必相等。现在要求用vba将其拆分为工作簿，工作簿名称为其姓名(张三李四等等)。请问如何操作？

Answer 1

右键点工作表名-查看代码 ，如下代码复制进去 ，F5运行， 生成文件在当前文件目录下

Sub 拆分()

Set sh = ActiveSheet
For i = 1 To sh.[iv1].End(xlToLeft).Column Step 5
WkName = sh.Cells(2, i + 1)
Sheets.Add.Name = WkName
sh.Columns(i).Resize(10000, 5).Copy Sheets(CStr(WkName)).[a1]
Sheets(CStr(WkName)).Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & WkName & ".xlsx"
ActiveWorkbook.Close True
Next
End Sub

Answer 2

Sub s()
Application.DisplayAlerts = False
pth = ThisWorkbook.Path & "\"
i = 2
Set wb = Workbooks.Add
wb.Activate
Do While Me.Cells(2, i) <> ""
Me.Columns(i - 1).Resize(, 5).Copy
ActiveSheet.Paste
wb.SaveCopyAs pth & Me.Cells(2, i) & ".xlsx"
i = i + 4
Loop
wb.Close False
Application.DisplayAlerts = True
End Sub本回答被网友采纳

Answer 3

Sub 拆分六列工作表到工作簿()
Dim i&, Sh As Worksheet, ShN As Worksheet, wb As Workbook
Set Sh = ActiveSheet
Set ShN = Worksheets.Add
For i = 1 To 1000 Step 6
ShN.Copy
Sh.Cells(1, i).Resize(1000, 6).Copy Worksheets(1).Cells(1, 1)
ActiveWorkbook.SaveAs "D:\" & Worksheets(1).Cells(2, 2) & ".xlsx"
ActiveWorkbook.Close False
Next i
Application.DisplayAlerts = False
ShN.Delete
Application.DisplayAlerts = True
End Sub
两个1000自己根据实际更改吧。本回答被网友采纳

Answer 4

如何使用Excel；VBA使用多个工作表拆分工作簿使用以多个规则命名的单个工作表拆分工作表由于您不提问，因此可以直接发布代码。子工作簿拆分（）将WB拆分为工作簿，将SH拆分为工作表中的每个SH'；遍历所有工作表sh.copy'；复制工作表集WB=activeworkbook'；到新工作簿k＝k+1'；计数；注：这一行也可以写为k=sh。如果这样写名称，这一行中的汉字将被删除。wb。另存为此工作簿。路径“/“；k〃；表xls“'；保存工作簿WB关闭”关闭创建的工作簿下一步