[已解决]指定列拆分工作薄

namesky1

各位老师好，找个了按指定列拆分工作薄的VBA，有些不适用我的情况，
有以下几个问题，不知道怎么修改，请帮忙改改，谢谢。


按A列拆分到工作薄
1.表头是两行时，只保留了1行
2.默认名称是按订单号，改成单位名称+订单号+特定文本的形式
3.指定生成工作薄保留那些表头及对应的内容

最佳答案

月排行榜 / 总排行榜

dsmch

2016-5-18 17:10

1. Sub Macro1()
   
2. mypath = ThisWorkbook.Path & ""
   
3. Set sht = ThisWorkbook.Sheets(1)
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. Application.SheetsInNewWorkbook = 1
   
7. For i = 3 To Range("a65536").End(xlUp).Row
   
8.     With Workbooks.Add
   
9.         sht.Cells(1, 1).Resize(2, 9).Copy .Sheets(1).[a1]
   
10.         sht.Cells(1, "l").Resize(2, 6).Copy .Sheets(1).Cells(1, 10)
    
11.         sht.Cells(i, 1).Resize(1, 9).Copy .Sheets(1).[a3]
    
12.         sht.Cells(i, "l").Resize(1, 6).Copy .Sheets(1).Cells(3, 10)
    
13.        .SaveAs Filename:=mypath & sht.Cells(i, 1) & ".xls"
    
14.         .Close 0
    
15.     End With
    
16. Next
    
17. Application.SheetsInNewWorkbook = 3
    
18. Application.DisplayAlerts = True
    
19. Application.ScreenUpdating = True
    
20. End Sub

复制代码

跳转到最佳答案楼层

爱疯

建议手动拆分为2个工作簿，以便理解题意

namesky1

爱疯 发表于 2016-5-18 10:43
建议手动拆分为2个工作簿，以便理解题意

版主好 已补充手动拆分后结果

爱疯

总表拆分成分表2.rar (23.85 KB, 下载次数: 4)

2016-5-18 16:56 上传

点击文件名下载附件


看不懂题意。
在 "(20160316-0415)验收报告（XXXXXXX）-MM-PO1101806.xlsx" 中，
为什么J3:03没有对应 "数据表拆分1" 的L4:Q4

dsmch

1. Sub Macro1()
   
2. mypath = ThisWorkbook.Path & ""
   
3. Set sht = ThisWorkbook.Sheets(1)
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. Application.SheetsInNewWorkbook = 1
   
7. For i = 3 To Range("a65536").End(xlUp).Row
   
8.     With Workbooks.Add
   
9.         sht.Cells(1, 1).Resize(2, 9).Copy .Sheets(1).[a1]
   
10.         sht.Cells(1, "l").Resize(2, 6).Copy .Sheets(1).Cells(1, 10)
    
11.         sht.Cells(i, 1).Resize(1, 9).Copy .Sheets(1).[a3]
    
12.         sht.Cells(i, "l").Resize(1, 6).Copy .Sheets(1).Cells(3, 10)
    
13.        .SaveAs Filename:=mypath & sht.Cells(i, 1) & ".xls"
    
14.         .Close 0
    
15.     End With
    
16. Next
    
17. Application.SheetsInNewWorkbook = 3
    
18. Application.DisplayAlerts = True
    
19. Application.ScreenUpdating = True
    
20. End Sub

复制代码

namesky1

爱疯 发表于 2016-5-18 16:57
看不懂题意。
在 "(20160316-0415)验收报告（XXXXXXX）-MM-PO1101806.xlsx" 中，
为什么J3:03没有 ...

应该是对应的  手动拆分的没沾错了~~抱歉

爱疯

如果要代码，就用5楼的吧

http://www.excelpx.com/thread-386168-1-1.html
这个工具也可以完成，注意
1）执行前，把不要的列删掉
2）其它步骤，参考动画

namesky1

爱疯 发表于 2016-5-18 20:00
如果要代码，就用5楼的吧

http://www.excelpx.com/thread-386168-1-1.html

谢谢版主 还是用代码吧  工具不错  不过如果多选了空单元格会提示错误 能忽略就好了

namesky1

dsmch 发表于 2016-5-18 17:10

能用  谢谢 就是文件名还要一个一个改

爱疯

namesky1 发表于 2016-5-18 21:27
谢谢版主 还是用代码吧  工具不错  不过如果多选了空单元格会提示错误 能忽略就好了

为更通用和安全，不得不去除一些特殊情况。
工具里有很多检查，也许是不适合你的情况。