基于单元格参数动态指定路径的Excel VBA跨文件复制需求

这里是优化后的代码，核心是从目标文件的「Rec」工作表读取动态参数来构建文件路径，同时优化了代码的稳定性和效率：

Sub LoadJPMTrans()
    Dim monthYear As String, dateStr As String
    Dim csvWB As Workbook, targetWB As Workbook
    Dim recSheet As Worksheet, sourceSheet As Worksheet, targetSheet As Worksheet
    Dim basePath As String, csvFile As String, targetFile As String
    
    ' 读取Rec工作表的年月和日期参数
    Set recSheet = ThisWorkbook.Sheets("Rec")
    monthYear = recSheet.Range("A1").Value
    dateStr = recSheet.Range("B1").Value
    
    ' 校验参数有效性
    If monthYear = "" Or dateStr = "" Then
        MsgBox "请确保「Rec」工作表A1（年月）和B1（日期）单元格不为空！", vbExclamation
        Exit Sub
    End If
    
    ' 动态拼接文件路径
    basePath = "D:\"
    csvFile = basePath & monthYear & "\" & dateStr & "\JPM Statement_MTD_" & dateStr & ".xls"
    targetFile = basePath & monthYear & "\" & dateStr & "\Daily Rec " & dateStr & ".xlsb"
    
    ' 打开源文件并检查是否存在
    On Error Resume Next
    Set csvWB = Workbooks.Open(csvFile)
    If Err.Number <> 0 Then
        MsgBox "源文件无法打开：" & csvFile & vbCrLf & "请检查路径是否正确！", vbCritical
        Exit Sub
    End On Error GoTo 0
    
    ' 打开目标文件并检查是否存在
    On Error Resume Next
    Set targetWB = Workbooks.Open(targetFile)
    If Err.Number <> 0 Then
        MsgBox "目标文件无法打开：" & targetFile & vbCrLf & "请检查路径是否正确！", vbCritical
        csvWB.Close SaveChanges:=False
        Exit Sub
    End On Error GoTo 0
    
    ' 定位源和目标工作表
    Set sourceSheet = csvWB.Sheets("Details")
    Set targetSheet = targetWB.Sheets("JPM Statement")
    
    ' 直接赋值复制数据（比剪贴板更高效稳定）
    targetSheet.Range("A:AH").Value = sourceSheet.Range("A:AH").Value
    
    ' 关闭文件并保存目标文件
    csvWB.Close SaveChanges:=False
    targetWB.Close SaveChanges:=True
    
    MsgBox "数据已成功复制到目标文件！", vbInformation
End Sub

关键优化点 #

• 动态路径生成：不再硬编码路径，而是从「Rec」工作表的A1和B1读取年月和日期，自动拼接出对应文件的完整路径
• 避免Active对象：用明确的工作簿/工作表变量代替ActiveWorkbook和Activate，减少因窗口切换导致的错误
• 错误检查：添加了参数空值、文件不存在的校验，出错时给出清晰提示，避免程序异常崩溃
• 高效复制：直接通过单元格值赋值的方式复制数据，跳过剪贴板，运行更快且更稳定

内容的提问来源于stack exchange，提问作者zoe wu