[已解决]有没有一个公式把1表分割成2、3、4、5

sunjing-zxl

回复 tayisha 的帖子

1. Sub 拆分工作薄()
   
2. Application.ScreenUpdating = False
   
3. Call 拆分工作表
   
4. Dim fd As FileDialog, path As String, sht As Worksheet
   
5. Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
6. If fd.Show = -1 Then
   
7. path = fd.SelectedItems(1) & IIf(Right(fd.SelectedItems(1), 1) = "", "", "")
   
8. Else: Exit Sub
   
9. End If
   
10. For Each sht In Sheets
    
11. sht.Copy
    
12. ActiveWorkbook.SaveAs path & sht.Name, xlWorkbookDefault
    
13. ActiveWorkbook.Close
    
14. Next sht
    
15. Application.ScreenUpdating = True
    
16. End Sub
    
17. Sub 拆分工作表()
    
18. Dim sht As Worksheet, bm As String
    
19. Dim Rng1 As Range, Rng2 As Range
    
20. Set Rng1 = Range("A1").Resize(1, 8)
    
21. K = [B65536].End(xlUp).Row
    
22. For Ro = 2 To [A65536].End(xlUp).Row
    
23. bm = Cells(Ro, 1)
    
24. i = Ro
    
25. Do
    
26. i = i + 1
    
27. If i > K Then
    
28. Exit Do
    
29. End If
    
30. Loop Until Cells(i, 1) <> ""
    
31. Set Rng2 = Range("A" & Ro).Resize(i - Ro, 8)
    
32. Set Rng2 = Union(Rng1, Rng2)
    
33. Set sht = Sheets.Add
    
34. sht.Name = bm
    
35. Rng2.Copy Sheets(bm).[A1]
    
36. Sheets("所属各地分公司").Select
    
37. Ro = i - 1
    
38. Next Ro
    
39. End Sub

复制代码

费了九牛二虎之力终于弄出来了：满意的话还是评一个最佳把
拆分工作薄.rar (12.37 KB, 下载次数: 23)

2011-4-22 20:49 上传

点击文件名下载附件

tayisha

回复 sunjing-zxl 的帖子

没看懂，但是结果很明显，目标达成

sunjing-zxl

回复 tayisha 的帖子

不懂VBA很难看的懂。。只要你会用就可以了
这个程序我都弄了一个多小时。。
都还查了很多资料才弄出来

tayisha

回复 sunjing-zxl 的帖子

问题是表是分开了，没有单独成表，还是在一个工作薄里么

tayisha

回复 sunjing-zxl 的帖子

看看内容都知道您费了很大精神，呵呵，谢谢孙博

sunjing-zxl

回复 tayisha 的帖子

不会啊，工作簿有表，而且把表也分开了

tayisha

回复 sunjing-zxl 的帖子

单独发给每个公司的时候是不是要单表发，不能把其他表也发过去呢，会泄密的

sunjing-zxl

回复 tayisha 的帖子

tayisha

回复 sunjing-zxl 的帖子

主要是我中午没看懂，现在研究下

chendaren

{:121:}不行啊