[已解决]关于工作表的拆分问题

sparkguo

向各位老师求助了，
工作中遇到的实际情况，需求如下：

1、拆分的工作表名称来源于C列（不重复）,拆分模拟效果见其他几个工作表

2、对应的内容规则为：以每个工作表D6为起始点的区域（数据区所在的工作表除外）

3、将拆分的新工作表另存为新的工作簿（每个工作簿名称与工作表名称相同），并导出至任意指定的区域


详细信息见附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-11-24 19:56

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim arr, sht As Worksheet, i&, s&
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. Set sht = ThisWorkbook.Sheets("数据区")
   
7. arr = Range("a1:c" & Range("c65536").End(xlUp).Row + 1)
   
8. s = 2
   
9. For i = 3 To UBound(arr)
   
10.     If arr(i, 3) <> arr(i - 1, 3) Then
    
11.        With Workbooks.Add
    
12.             sht.[a1:c1].Copy .Sheets(1).[a1] '标题a1
    
13.             sht.Range(sht.Cells(s, 1), sht.Cells(i - 1, 3)).Copy .Sheets(1).[a2] '内容a2
    
14.             .SaveAs Filename:=ThisWorkbook.Path & "" & arr(s, 3) & ".xls"
    
15.             Workbooks(arr(s, 3)).Close 1
    
16.         End With
    
17.         s = i
    
18.     End If
    
19. Next
    
20. Application.DisplayAlerts = True
    
21. Application.ScreenUpdating = True
    
22. End Sub

复制代码

跳转到最佳答案楼层

qh8600

论坛上有分表的贴子，自己找找就可以啦

dsmch

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim arr, sht As Worksheet, i&, s&
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. Set sht = ThisWorkbook.Sheets("数据区")
   
7. arr = Range("a1:c" & Range("c65536").End(xlUp).Row + 1)
   
8. s = 2
   
9. For i = 3 To UBound(arr)
   
10.     If arr(i, 3) <> arr(i - 1, 3) Then
    
11.        With Workbooks.Add
    
12.             sht.[a1:c1].Copy .Sheets(1).[a1] '标题a1
    
13.             sht.Range(sht.Cells(s, 1), sht.Cells(i - 1, 3)).Copy .Sheets(1).[a2] '内容a2
    
14.             .SaveAs Filename:=ThisWorkbook.Path & "" & arr(s, 3) & ".xls"
    
15.             Workbooks(arr(s, 3)).Close 1
    
16.         End With
    
17.         s = i
    
18.     End If
    
19. Next
    
20. Application.DisplayAlerts = True
    
21. Application.ScreenUpdating = True
    
22. End Sub

复制代码

dsmch

………………

sparkguo

dsmch 发表于 2014-11-24 19:56

老师，我是小白， 代码可以备注一下吗？
谢谢老师了

dsmch

论坛上有程序解释器
http://www.excelpx.com/forum.php ... 2%BD%E2%CA%CD%C6%F7