多SHEET表拆分范例

楼主 huangwei0king	Option Explicit Sub 拆分表() On Error Resume Next Dim i, m Dim j, n Dim cl As Integer, r As Integer Dim dic, arr, k Dim s, st Dim str As String Dim fp Dim fname Dim hs, ls Dim arrr, x Dim brr() As String Dim b1, b2 Set dic = CreateObject("Scripting.Dictionary") m = Worksheets.Count cl = InputBox("请输入拆分标准列【省】所在列数") r = InputBox("请输入拆分标准列【省】从哪行开始") str = InputBox("请输入拆分后各省文件统一名称") fp = ThisWorkbook.Path Application.SheetsInNewWorkbook = m '计算一共出现多少个省的数据 For i = 1 To m n = Sheets(i).Range("a1000000").End(xlUp).Row '计算每个SHEET有多少行数据 arr = Sheets(i).Range(Sheets(i).Cells(r, cl), Sheets(i).Cells(n, cl)) For j = 1 To n - 1 dic(arr(j, 1)) = 1 Next Erase arr Next '将字典中的省份名称数据赋值给数组K k = dic.keys '根据字典中的省份名称进行表拆分操作 For s = 1 To UBound(k) + 1 Workbooks.Add '给新增的工作薄的分表设置格式 For st = 1 To m Workbooks(2).Sheets(st).Name = ThisWorkbook.Sheets(st).Name ThisWorkbook.Sheets(st).Rows("1:" & r - 1).Copy Workbooks(2).Sheets(st).Rows("1:" & r - 1) Next '对汇总数据进行拆分操作 For st = 1 To m hs = ThisWorkbook.Sheets(st).Range("a1000000").End(xlUp).Row ls = ThisWorkbook.Sheets(st).Range("xfd1").End(xlToLeft).Column arrr = ThisWorkbook.Sheets(st).Range(ThisWorkbook.Sheets(st).Cells(r, 1), ThisWorkbook.Sheets(st).Cells(hs, ls)) '把符合该省的该SHEET的数据全复制给数组BRR b1 = 0 For x = 1 To UBound(arrr) If arrr(x, cl) = k(s - 1) Then b1 = b1 + 1 ReDim Preserve brr(1 To ls, 1 To b1) For b2 = 1 To ls brr(b2, b1) = arrr(x, b2) Next End If Next '如果数组BRR为空，即该SHEET没有这个省的数据，那么不进行如下复制操作 If UBound(brr()) >= 0 Then Workbooks(2).Sheets(st).Range(Workbooks(2).Sheets(st).Cells(r, 1), Workbooks(2).Sheets(st).Cells(UBound(brr(), 2) + r - 1, ls)) = Application.Transpose(brr) End If '清空数组，以使下一次操作顺利 Erase brr Erase arrr Next '保存文件，并给文件名命名及赋予路径 fname = str & k(s - 1) Workbooks(2).SaveAs Filename:=fp & "\" & fname & ".xlsx" Workbooks(2).Close Next End Sub 上面是我做的一个多表进行拆分的代码，用来拆分具有多个SHEET的汇总数据，拆分要求为按省拆分，拆分后的表和汇总表的SHEET个数一样！代码比较啰嗦，这里主要就是抛砖引玉，欢迎大家一起讨论！谢谢！本例是以我工作遇到的数据为例（数据已处理过）！ (TEST).rar
2楼海洋之星	帖子内容不错,建议按"ｅ问ｅ答"形式发帖.具体参考下帖: ｅ问ｅ答发帖技巧和写作规范 http://www.exceltip.net/thread-4376-1-1.html
3楼 lrlxxqxa	一上来就是代码，会让读者一头雾水，建议按照提出问题、分析问题、解决问题的思路完善正文结构，必要处以图片辅助呈现