如何将总表拆分成多个分表

杳杳大魔王

怎么将数据源拆分成以部门为单位的多个分表

杳杳大魔王

求大神指导

2489586288

按列拆分，老生常谈

杳杳大魔王

2489586288 发表于 2019-2-11 20:43
按列拆分，老生常谈

求大神指导，谢谢

左面的鱼

按列拆分是不用VBA就能实现吗？想知道。
这个问题网上搜搜就能找到代码。
下面代码就是按A列拆分，从网上找的。

1. Sub Sepsheets()
   
2. ' Sepsheets Macro
   
3. ' 将工作薄的内容按A列分类从第二行开始放入不同工作薄中。
   
4. Dim i As Integer
   
5. Dim j As Integer
   
6. ' i & j 用于行循环
   
7. Dim k As Integer
   
8. Dim h As Integer
   
9. ' k & h用于excel表单循环
   
10. Dim m As Integer
    
11. 'm用于根据表头内容判断有多少列需要分页
    
12. Dim n As Integer
    
13. '临时变量，用于判断是否需要新建表单
    
14. Dim p As String
    
15. 'p 代表当前工作表单表单名
    
16. Dim q As String
    
17. 'q用于表示以A列中分类的内容为名建立的表单
    
18. Range("a1").Select
    
19. p = ActiveSheet.Name
    
20. j = ActiveSheet.[a65536].End(3).Row
    
21. m = Sheets(p).Cells(1, 256).End(xlToLeft).Column
    
22. h = Sheets.Count
    
23. n = 0
    
24. For i = 2 To j
    
25.     Sheets(p).Select
    
26.     If Range("A" & i).Value <> "" Then
    
27.    
    
28.         For k = 1 To h
    
29.             If Sheets(k).Name <> Range("A" & i).Value Then
    
30.                 n = n + 1
    
31.             End If
    
32.         Next k
    
33.         If n = h Then
    
34.             Sheets.Add after:=Sheets(h)
    
35.             h = h + 1
    
36.             Sheets(h).Name = Sheets(p).Range("A" & i).Value
    
37.             Sheets(p).Range("A1:" & Chr(m + 64) & "1").Copy Sheets(h).Range("a1")
    
38.         End If
    
39.         n = 0
    
40.         q = Sheets(p).Range("A" & i).Value
    
41.         Sheets(p).Range("A" & i & ":" & Chr(m + 64) & i).Copy Sheets(q).[a65536].End(3).Offset(1, 0)
    
42.     End If
    
43. Next i
    
44. End Sub

复制代码

xrmay

收藏一下