[已解决]求高手帮忙，用vba解决筛选后复制数据到另一个表中

jimolaojiu

对于vba的学习，我是个新手，但工作上极需解决现在遇到的问题，求高手指点。从总表中分别把各分店筛选（用分店名称筛选）出来，然后把数据再复制到相关的各分店的表中，谢谢。

最佳答案

月排行榜 / 总排行榜

EXCEL-YQ

2011-9-22 19:01

1. Option Explicit
   
2. 
   
3. Sub AutoFil()
   
4. Dim ForI As Long, EndRow As Long, StrCriteria1 As String
   
5. '定义循环变量ForI，求最后非空单元格行号EndRow，筛选值变量StrCriteria1
   
6. Application.ScreenUpdating = False
   
7. '禁止屏幕刷新功能
   
8. Sheet1.Range("A1:E1").AutoFilter
   
9. 'A1:E1自动筛选
   
10. For ForI = 1 To Sheets.Count
    
11. '从1开始循环到工作表的总个数
    
12. If Sheets(ForI).Name <> "总表" Then
    
13. '判断，如果循环到的工作表名称不等于 总表 那么运行下面代码
    
14. StrCriteria1 = Sheets(ForI).Name
    
15. '将当前循环到的工作表名称赋值给变量StrCriteria1
    
16. Sheet1.Range("A1").AutoFilter Field:=1, Criteria1:=StrCriteria1
    
17. '筛选A1单元格的值为变量StrCriteria1的值
    
18. EndRow = Sheet1.Range("A65536").End(xlUp).Row
    
19. '求总表以A列为准的最后一个非空单元格行号
    
20. Sheets(ForI).Cells.Clear
    
21. '清除当前循环到的工作表
    
22. Sheet1.Range("A1:E" & EndRow).Copy Sheets(ForI).Range("A1")
    
23. '将筛选的结果复制到当前循环到的工作表
    
24. End If
    
25. Next
    
26. Sheet1.Range("A1:E1").AutoFilter
    
27. '取消自动筛选
    
28. Application.ScreenUpdating = True
    
29. '恢复屏幕刷新
    
30. End Sub
    

复制代码

筛选后复制数据到另一个表中.rar (8.75 KB, 下载次数: 865)

2011-9-22 19:01 上传

点击文件名下载附件

跳转到最佳答案楼层

EXCEL-YQ

1. Option Explicit
   
2. 
   
3. Sub AutoFil()
   
4. Dim ForI As Long, EndRow As Long, StrCriteria1 As String
   
5. '定义循环变量ForI，求最后非空单元格行号EndRow，筛选值变量StrCriteria1
   
6. Application.ScreenUpdating = False
   
7. '禁止屏幕刷新功能
   
8. Sheet1.Range("A1:E1").AutoFilter
   
9. 'A1:E1自动筛选
   
10. For ForI = 1 To Sheets.Count
    
11. '从1开始循环到工作表的总个数
    
12. If Sheets(ForI).Name <> "总表" Then
    
13. '判断，如果循环到的工作表名称不等于 总表 那么运行下面代码
    
14. StrCriteria1 = Sheets(ForI).Name
    
15. '将当前循环到的工作表名称赋值给变量StrCriteria1
    
16. Sheet1.Range("A1").AutoFilter Field:=1, Criteria1:=StrCriteria1
    
17. '筛选A1单元格的值为变量StrCriteria1的值
    
18. EndRow = Sheet1.Range("A65536").End(xlUp).Row
    
19. '求总表以A列为准的最后一个非空单元格行号
    
20. Sheets(ForI).Cells.Clear
    
21. '清除当前循环到的工作表
    
22. Sheet1.Range("A1:E" & EndRow).Copy Sheets(ForI).Range("A1")
    
23. '将筛选的结果复制到当前循环到的工作表
    
24. End If
    
25. Next
    
26. Sheet1.Range("A1:E1").AutoFilter
    
27. '取消自动筛选
    
28. Application.ScreenUpdating = True
    
29. '恢复屏幕刷新
    
30. End Sub
    

复制代码

筛选后复制数据到另一个表中.rar (8.75 KB, 下载次数: 865)

2011-9-22 19:01 上传

点击文件名下载附件

alsacewho

下载来学习学习

aagen

学习了

谢谢了

courageous

学习一下