两表之间拷贝

djyang

• 把A中分析表的A到b列拷贝到b中成本表的A到b列（从a3和b3开始）
• 把A中分析表的c到h列拷贝到b中成本表的d到i列（从d3和i3开始）
  两表复制.rar (17.01 KB, 下载次数: 4)

  2018-10-15 21:15 上传

  点击文件名下载附件
  
  

lsc900707

同时打开两个工作簿直接拷贝就好！

lsc900707

方法二参考附件：

djyang

lsc900707 发表于 2018-10-15 22:01
同时打开两个工作簿直接拷贝就好！

谢谢老师，不过用宏快点

djyang

lsc900707 发表于 2018-10-15 22:03
方法二参考附件：

谢谢老师完全解决问题

djyang

lsc900707 发表于 2018-10-15 22:03
方法二参考附件：

老师在B表用公试=LOOKUP(B3,目录!$A$2:$A$29,目录!$B$2:$B$29)，可以找到值，
Sub gj23w98()
    Set wb = GetObject(ThisWorkbook.Path & "\" & "a.xls")
    With wb.Sheets(1)
        r = .Cells(.Rows.Count, 1).End(3).Row
        .Range("a2:b" & r).Copy [a3]
        .Range("c2:h" & r).Copy [d3]
    End With
    wb.Close False
End Sub
那宏用什么代码加入可以达到相同的效果。 两表复制.rar (17.77 KB, 下载次数: 5)

2018-10-16 06:53 上传

点击文件名下载附件

lsc900707

djyang 发表于 2018-10-16 06:53
老师在B表用公试=LOOKUP(B3,目录!$A$2:$A$29,目录!$B$2:$B$29)，可以找到值，
Sub gj23w98()
    Set w ...

注意代码中第三行引号有“\"

1. Sub gj23w98()
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Set wb = GetObject(ThisWorkbook.Path & "" & "a.xls")
   
4.     With wb.Sheets(1)
   
5.         r = .Cells(.Rows.Count, 1).End(3).Row
   
6.         .Range("a2:b" & r).Copy [a3]
   
7.         .Range("c2:h" & r).Copy [d3]
   
8.     End With
   
9.     wb.Close False
   
10.     arr = Sheet1.[a1].CurrentRegion
    
11.     For i = 2 To UBound(arr)
    
12.         d(arr(i, 1)) = arr(i, 2)
    
13.     Next
    
14.     brr = [a1].CurrentRegion
    
15.     For i = 3 To UBound(brr)
    
16.         brr(i, 3) = d(brr(i, 2))
    
17.     Next
    
18.     [a1].CurrentRegion = brr
    
19. End Sub

复制代码

djyang

lsc900707 发表于 2018-10-16 07:21
注意代码中第三行引号有“\"

谢谢老师帮忙。