[已解决]如何用VBA复制合并多工作表数据/文本

氧化钙

如题！用VBA将其它三个表的A:B列材料编码、名称复制合并到物料需求表对应的A:B列，请VBA高手指教并提供代码……谢啦……

最佳答案

月排行榜 / 总排行榜

lisachen

2011-12-7 18:38

1. Private Sub Worksheet_Activate()
   
2. Dim d As Object
   
3. Dim sh
   
4. Dim arr
   
5. Dim i As Long
   
6. Set d = CreateObject("Scripting.Dictionary")
   
7. For Each sh In Sheets
   
8. If sh.Name <> ActiveSheet.Name Then
   
9. arr = sh.Range("A1:B" & sh.Range("A" & Rows.Count).End(xlUp).Row)
   
10. For i = 1 To UBound(arr)
    
11. d(arr(i, 1)) = arr(i, 2)
    
12. Next
    
13. End If
    
14. Next
    
15. ActiveSheet.Columns("A:A") = ""
    
16. Range("A1").Resize(d.Count, 1) = Application.Transpose(d.keys)
    
17. Range("B1").Resize(d.Count, 1) = Application.Transpose(d.items)
    
18. Set d = Nothing
    
19. End Sub
    

复制代码

工作表复制合并.rar (11.73 KB, 下载次数: 154)

2011-12-7 19:00 上传

点击文件名下载附件
事件程序中

跳转到最佳答案楼层

BAIXINGR

你是要一次性操作呢还是要求以后后边两个表有增减，这边也增减呢.问题不明白

lisachen

1. Private Sub Worksheet_Activate()
   
2. Dim d As Object
   
3. Dim sh
   
4. Dim arr
   
5. Dim i As Long
   
6. Set d = CreateObject("Scripting.Dictionary")
   
7. For Each sh In Sheets
   
8. If sh.Name <> ActiveSheet.Name Then
   
9. arr = sh.Range("A1:B" & sh.Range("A" & Rows.Count).End(xlUp).Row)
   
10. For i = 1 To UBound(arr)
    
11. d(arr(i, 1)) = arr(i, 2)
    
12. Next
    
13. End If
    
14. Next
    
15. ActiveSheet.Columns("A:A") = ""
    
16. Range("A1").Resize(d.Count, 1) = Application.Transpose(d.keys)
    
17. Range("B1").Resize(d.Count, 1) = Application.Transpose(d.items)
    
18. Set d = Nothing
    
19. End Sub
    

复制代码

工作表复制合并.rar (11.73 KB, 下载次数: 154)

2011-12-7 19:00 上传

点击文件名下载附件
事件程序中

氧化钙

谢谢提醒！能不能两种情况都提供代码呢？1、一次性操作是我现在要做的；2、以后也会有增删的情况，未雨绸缪啊！谢谢BAIXINGR 兄！

氧化钙

先谢谢lisachen 版主！先用来完成工作再说！因为材料BOM表很多，手工操作今晚都没法完成！太感谢了！急需学习VBA知识！另外还得感谢关注本贴的其它朋友，如有其它答案一并收了慢慢学习！