如何通过VBA进行跨工作簿复制值？

kuiblue

问题：怎样 通过VBA 将 表A 的数据（标黄色） 通过A列为参考 复制到 表B (值为没公式的)对应的位置？谢谢，详见附件（问题在表B） 新建文件夹.zip (16.18 KB, 下载次数: 30)

2015-6-25 23:46 上传

点击文件名下载附件

请在“表A”设置VBA，谢谢！

huang1314wei

1. 
   

复制代码

1. Sub 复制()
   
2.      Dim arr, i%, j%
   
3.      Application.ScreenUpdating = False
   
4.      arr = Range("A1:G" & Range("A1048576").End(3).Row)
   
5.      Workbooks.Open (ThisWorkbook.Path & "\表A.xlsx")
   
6.      j = ActiveWorkbook.Sheets(1).Range("A1048576").End(3).Row
   
7.      brr = ActiveWorkbook.Sheets(1).Range("A1:G" & j)
   
8.      Workbooks("表A.xlsx").Close False
   
9.      For i = 2 To UBound(arr)
   
10.         For m = 2 To UBound(brr)
    
11.             If arr(i, 1) <> "小计" And arr(i, 1) = brr(m, 1) Then
    
12.                For n = 2 To UBound(brr, 2)
    
13.                 arr(i, n) = brr(m, n)
    
14.                Next
    
15.             End If
    
16.         Next
    
17.      Next
    
18.      Range("A1:G" & Range("A1048576").End(3).Row) = arr
    
19.      Application.ScreenUpdating = True
    
20.      MsgBox "复制完毕！"
    
21. End Sub
    

复制代码

huang1314wei

附件供参考

新建文件夹.rar (26.42 KB, 下载次数: 102)

2015-6-26 07:23 上传

点击文件名下载附件

huang1314wei

1. Sub 数据导入()
   
2.      Dim arr, i%, j%
   
3.      Application.ScreenUpdating = False
   
4.      arr = Range("A1:G" & Range("A1048576").End(3).Row)
   
5.      Workbooks.Open (ThisWorkbook.Path & "\表B.xlsx")
   
6.      With ActiveWorkbook.Worksheets("Sheet4")
   
7.      j = .Range("A1048576").End(3).Row
   
8.      brr = .Range("A1:G" & j)
   
9.      For i = 2 To UBound(brr)
   
10.         For m = 2 To UBound(arr)
    
11.             If brr(i, 1) <> "小计" And brr(i, 1) = arr(m, 1) Then
    
12.                For n = 2 To UBound(brr, 2)
    
13.                 brr(i, n) = arr(m, n)
    
14.                Next
    
15.             End If
    
16.         Next
    
17.      Next
    
18.      .Range("A1:G" & j) = brr
    
19.      End With
    
20.      Workbooks("表B.xlsx").Close True
    
21.      Application.ScreenUpdating = True
    
22.      MsgBox "数据导入表B成功！"
    
23. End Sub
    

复制代码

huang1314wei

附件如下
表A当中写代码.rar (26.33 KB, 下载次数: 148)

2015-6-26 14:22 上传

点击文件名下载附件

kuiblue

多谢老师们的回答，谢谢！

kuiblue

老师： 表B 中的小计公式也变为值了，目的也要保留表Ｂ“小计”的公式，请问如何修改，谢谢！

fjhajh

huang1314wei 发表于 2015-6-26 14:22
附件如下

前辈 请留个联系方式 ，有问题请教

CYZ凡星点点

多谢老师们的回答，谢谢！