打开工作簿跨文件复制信息的VBA代码未按预期复制单元格值

现存代码的核心问题 #

• 文件筛选器参数语法错误：GetOpenFilename 的筛选规则需遵循「显示描述, 实际匹配通配符」的格式，多通配符需用分号分隔。原代码将描述文字和通配符混排，会导致文件选择对话框的筛选逻辑异常，极端场景下获取的文件路径存在截断。
• 剪贴板内容提前失效：原代码流程为「复制源区域到剪贴板 → 执行粘贴 → 立即关闭源工作簿」，Excel 关闭工作簿时会同步释放对应剪贴板的内容，部分场景下会导致 PasteSpecial 执行时剪贴板无有效内容，最终没有实际数值写入目标区域，仅保留目标单元格原有的下拉数据验证，与实际运行现象完全匹配。
• 不必要的剪贴板依赖：纯数值粘贴场景完全不需要走「复制-粘贴」的剪贴板流程，直接通过区域值赋值的方式既能提升运行速度，也能彻底规避剪贴板失效、内存占用高的问题。

修正后的可运行代码 #

Sub casesopenfile()
    Dim filetoopen As Variant ' 适配GetOpenFilename的返回值类型，避免类型转换异常
    Dim Casesbook As Workbook
    Dim targetSht As Worksheet
    
    ' 修正文件筛选器格式，多通配符用分号分隔
    filetoopen = Application.GetOpenFilename(Title:="Choose a file", Filefilter:="Excel Files (*.xls*;*.xlsx), *.xls*;*.xlsx")
    
    ' 严谨判断用户是否取消了文件选择
    If VarType(filetoopen) = vbBoolean Then
        MsgBox "No file selected", vbExclamation, "Sorry"
        Exit Sub
    End If
    
    ' 以只读模式打开源文件，避免源文件被占用
    Set Casesbook = Application.Workbooks.Open(filetoopen, ReadOnly:=True)
    Set targetSht = ThisWorkbook.Worksheets("Cases 2017-2021")
    
    ' 直接赋值区域值，和纯数值粘贴效果完全一致，无剪贴板依赖
    targetSht.Range("A1121:AC1420").Value = Casesbook.Sheets(1).Range("A1:Q300").Value
    
    ' 关闭源工作簿，不保存任何修改
    Casesbook.Close SaveChanges:=False
End Sub

补充说明 #

• 直接值赋值时，目标区域的行列范围需要和源区域完全匹配：源区域为A1:Q300（共17列、300行），对应从A1121起始的目标范围为A1121:AC1420，避免因区域大小不匹配导致的赋值报错。
• 原代码运行时目标区域仅保留下拉列表、无实际数值的现象，本质是因为PasteSpecial执行时剪贴板无有效内容，根本没有写入任何数据，原有单元格的下拉数据验证自然会完整保留。用直接值赋值的方式，会将源区域的数值直接写入目标单元格，原有单元格的值会被完全替换。
• 以只读模式打开源文件，可以避免源文件被当前进程锁定，其他用户无法编辑的问题。

内容的提问来源于stack exchange，提问作者Mariana Anaya Villafaña