VBA开发求助：如何将Excel单元格值存入变量并跨工作簿粘贴？

需求说明 #

需要完成以下操作：

• 复制工作簿Riepilogo_Selezioni2.xlsm中单元格AD1的值
• 清空该单元格
• 将值粘贴到宏所在的工作簿Presa_in_Carico.xlsm中

原代码尝试通过变量实现跨工作簿调用但未成功，原代码如下：

Range("A2:B2").Select
Selection.Copy
Workbooks.Open Filename:="F:\SCN\Riepilogo_Selezioni2.xlsm"
Application.DisplayAlerts = False
Range("AD1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False
'here I want to declare AD1.value as range
Range("AE1").Select
Selection.Copy
Range("a3:a65535").Find(What:=Range("AD1").Value).Select
ActiveCell.Offset(0, 30).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True
            
Range("AD1:AE1").Select
Selection.ClearContents

Range("A2").Select
Selection.End(xlDown).Offset(1, 0).Select

ActiveWorkbook.Save
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
'Fine Trova e compila su Selezioni2

Range("A65536").Select
Selection.End(xlUp).Offset(1, 0).Select

' here i want to paste the AD1.value
MsgBox "Richiesta registrata correttamente!"

修改后的完整代码 #

Sub CopiaValoreTraWorkbook()
    Dim wbCorrente As Workbook
    Dim wbSelezioni As Workbook
    Dim valoreAD1 As Variant
    Dim rngCerca As Range
    
    ' 绑定宏所在的工作簿，避免后续操作混淆上下文
    Set wbCorrente = ThisWorkbook
    
    ' 复制当前工作簿A2:B2区域的值
    wbCorrente.Range("A2:B2").Copy
    
    ' 打开目标工作簿并绑定变量
    Set wbSelezioni = Workbooks.Open(Filename:="F:\SCN\Riepilogo_Selezioni2.xlsm")
    Application.DisplayAlerts = False
    
    ' 粘贴值到目标工作簿的AD1单元格
    wbSelezioni.Range("AD1").PasteSpecial Paste:=xlPasteValues
    
    ' 关键：在清空AD1前，把值存入变量保存
    valoreAD1 = wbSelezioni.Range("AD1").Value
    
    ' 复制AE1的值，查找匹配项后粘贴到指定位置
    wbSelezioni.Range("AE1").Copy
    Set rngCerca = wbSelezioni.Range("A3:A65535").Find(What:=valoreAD1)
    ' 增加判断，避免找不到匹配项时出错
    If Not rngCerca Is Nothing Then
        rngCerca.Offset(0, 30).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    End If
    
    ' 清空AD1和AE1单元格
    wbSelezioni.Range("AD1:AE1").ClearContents
    
    ' 保存并关闭目标工作簿
    wbSelezioni.Save
    wbSelezioni.Close
    Application.DisplayAlerts = True
    
    ' 回到宏所在工作簿，将保存的AD1值粘贴到指定位置
    wbCorrente.Range("A65536").End(xlUp).Offset(1, 0).Value = valoreAD1
    
    MsgBox "Richiesta registrata correttamente!"
End Sub

核心改动说明 #

• 绑定工作簿变量：用wbCorrente和wbSelezioni分别指向两个工作簿，彻底摆脱Select和ActiveWorkbook带来的上下文混乱问题
• 提前保存目标值到变量：在清空AD1单元格之前，将其值存入valoreAD1变量，确保目标工作簿关闭后仍能使用该值
• 移除冗余的Select操作：直接通过「工作簿对象+单元格区域」的方式操作，提升代码执行效率和稳定性
• 增加Find操作的非空判断：防止找不到匹配项时触发运行时错误，增强代码健壮性

内容的提问来源于stack exchange，提问作者Marco Giraudo