求助不用复制粘贴，让VBA实现多区域自动对应粘贴

yxf1366

代码要在目标工作簿”日就餐情况.xlsm“中存放，想实现从不打开（或已打开状态）的”2024日取表模板.xlsm“工作簿中拷贝其内指定”日样表“工作表中的三个区域A3：C19 、E3：G19  、I3:K19到目标工作簿”日就餐情况.xlsm“中 ，运行VBA时可以弹出对话框，让用户输入目标工作表的名称 （如3.1或3.20等已有工作表）  在已输入并存在的工作表的对应A3：C19 、E3：G19  、I3:K19区域内的数值性粘贴源表中的数据，根据内容能自适应行高。  复制粘贴本是可以的，但就想用VBA实现！请指教小白并写出完整代码！！！

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.1.19
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3.     For Each sht In Sheets
   
4.         If Val(sht.Name) Then
   
5.             d(sht.Name) = ""
   
6.         End If
   
7.     Next
   
8.     p = ThisWorkbook.Path
   
9.     f = p & "\2024日取表模板.xlsm"
   
10.     Set wb = Workbooks.Open(f, 0)
    
11.     With wb.Sheets(1)
    
12.         arr = .[a3:c19]
    
13.         brr = .[e3:g19]
    
14.         crr = .[i3:k19]
    
15.         wb.Close False
    
16.     End With
    
17.     fn = Application.InputBox("请输入表名：", "工作表名", "3.1")
    
18.     If fn = Empty Then Exit Sub
    
19.     If Not d.exists(fn) Then MsgBox "输入的工作表名不存在，请重新输入！": Exit Sub
    
20.     Set sht = Sheets(fn)
    
21.     With sht
    
22.       .[a3:c19] = arr
    
23.       .[e3:g19] = brr
    
24.       .[i3:k19] = crr
    
25.     End With
    
26.     Set d = Nothing
    
27.     MsgBox "OK！"
    
28. End Sub
    

复制代码

ykcbf1100

附件供参考。。。

yxf1366

ykcbf1100 发表于 2024-1-19 07:57
参与一下。。。

  向您致敬，我要学习学习VBA啦