[已解决]求VBA代码，把一个工作表中的数据提取出来到新建的工作表中

hfqyqtyd

在一个工作表中有很多相同的表（内容不同），想写一段VBA代码，把这些相同的表分开，分别存入新建的工作表中，并为把新建的工作表分别取名为：二二班1，二二班2……
谢谢！
附件如下：

2.2.rar (87.86 KB, 下载次数: 9)

2013-9-28 15:18 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

yyyydddd8888

2013-9-28 15:26

看看这个可以吗？

1. Sub 拆分()
   
2. Dim x&, na&
   
3. Application.ScreenUpdating = False
   
4. For x = 1 To Sheets("4.学生基本信息表").Range("a65536").End(3).Row Step 112
   
5. If Sheets("4.学生基本信息表").Cells(x, 1) = "学生基本信息表" Then
   
6. Sheets.Add after:=Sheets(Sheets.Count)
   
7. na = na + 1
   
8. i = Sheets.Count
   
9. Sheets(i).Name = "二二班" & na
   
10. Sheets("4.学生基本信息表").Cells(x, 1).Resize(112, 8).Copy Sheets(i).Range("a1")
    
11. End If
    
12. Next x
    
13. Application.ScreenUpdating = True
    
14. End Sub

复制代码

2.2.rar (105.65 KB, 下载次数: 29)

2013-9-28 16:47 上传

点击文件名下载附件

2.2.rar (105.65 KB, 下载次数: 11)

2013-9-28 16:48 上传

点击文件名下载附件

跳转到最佳答案楼层

yyyydddd8888

看看这个可以吗？

1. Sub 拆分()
   
2. Dim x&, na&
   
3. Application.ScreenUpdating = False
   
4. For x = 1 To Sheets("4.学生基本信息表").Range("a65536").End(3).Row Step 112
   
5. If Sheets("4.学生基本信息表").Cells(x, 1) = "学生基本信息表" Then
   
6. Sheets.Add after:=Sheets(Sheets.Count)
   
7. na = na + 1
   
8. i = Sheets.Count
   
9. Sheets(i).Name = "二二班" & na
   
10. Sheets("4.学生基本信息表").Cells(x, 1).Resize(112, 8).Copy Sheets(i).Range("a1")
    
11. End If
    
12. Next x
    
13. Application.ScreenUpdating = True
    
14. End Sub

复制代码

2.2.rar (105.65 KB, 下载次数: 29)

2013-9-28 16:47 上传

点击文件名下载附件

2.2.rar (105.65 KB, 下载次数: 11)

2013-9-28 16:48 上传

点击文件名下载附件

yezhikang

学习了、

yezhikang

学习

wuyuechina

向高手学习。。。。