VBA宏优化需求：避免硬编码文件路径及添加错误处理

针对你的需求，我重写并优化了宏代码，解决硬编码路径问题同时添加了完整的错误处理机制，还修正了原代码中引用文件名不一致的潜在bug：

优化后的完整代码 #

Sub MacroCopy()
    Dim sourceWB As Workbook
    Dim sourceWS As Worksheet
    Dim targetWS As Worksheet
    Dim fileDialog As FileDialog
    Dim sourceFilePath As String
    
    ' 初始化错误处理
    On Error GoTo ErrorHandler
    
    ' 绑定主工作簿的目标工作表
    Set targetWS = ThisWorkbook.Worksheets("targetworksheet")
    
    ' 弹出文件选择对话框，让用户选择源数据文件
    Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fileDialog
        .Title = "请选择源数据文件"
        .Filters.Clear
        .Filters.Add "Excel文件", "*.xlsx;*.xlsm" ' 只显示支持的Excel格式
        .AllowMultiSelect = False ' 限制单次选择一个文件
        
        ' 判断用户是否选择了文件
        If .Show = -1 Then
            sourceFilePath = .SelectedItems(1)
        Else
            MsgBox "未选择源文件，宏已终止", vbInformation
            GoTo Cleanup
        End If
    End With
    
    ' 验证所选文件是否存在
    If Dir(sourceFilePath) = "" Then
        MsgBox "所选文件不存在，请重新选择", vbExclamation
        GoTo Cleanup
    End If
    
    ' 禁用屏幕更新，提升宏运行效率
    Application.ScreenUpdating = False
    ' 只读打开源文件，避免占用文件导致其他用户无法编辑
    Set sourceWB = Workbooks.Open(sourceFilePath, ReadOnly:=True)
    
    ' 绑定源文件的目标工作表（注意替换为实际表名，原代码存在名称不一致问题）
    Set sourceWS = sourceWB.Worksheets("sourceworksheet")
    
    ' 检查列表对象是否存在
    If Not sourceWS.ListObjects("Sourcesheet") Is Nothing Then
        ' 应用筛选条件
        sourceWS.ListObjects("Sourcesheet").Range.AutoFilter Field:=16, Criteria1:=Array("1", "2", "3", "4", "5"), Operator:=xlFilterValues
    Else
        MsgBox "源工作表中未找到列表对象 'Sourcesheet'", vbExclamation
        GoTo Cleanup
    End If
    
    ' 仅复制筛选后的可见单元格，避免复制空行
    sourceWS.Range("B5:EO11332").SpecialCells(xlCellTypeVisible).Copy _
        targetWS.Range("B5")
    
    MsgBox "数据复制完成！", vbInformation

Cleanup:
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    ' 关闭源文件（如果已成功打开）
    If Not sourceWB Is Nothing Then
        sourceWB.Close SaveChanges:=False ' 只读打开无需保存
    End If
    ' 释放所有对象变量，避免内存泄漏
    Set sourceWB = Nothing
    Set sourceWS = Nothing
    Set targetWS = Nothing
    Set fileDialog = Nothing
    Exit Sub

ErrorHandler:
    ' 弹出错误详情
    MsgBox "运行出错：" & Err.Description & vbCrLf & "错误代码：" & Err.Number, vbCritical
    ' 跳转到清理流程，确保资源正常释放
    GoTo Cleanup
End Sub

关键优化说明 #

• 摆脱硬编码路径：通过Application.FileDialog让用户可视化选择源文件，无论文件名或存储路径如何变更，都能正确定位文件。
• 完整错误处理：
  • 捕获所有运行时错误，弹出清晰的错误信息，避免宏直接崩溃
  • 验证用户是否取消文件选择、文件是否存在
  • 检查工作表、列表对象是否存在，避免引用无效对象
• 细节优化：
  • 禁用屏幕更新提升运行速度
  • 只读打开源文件，避免文件锁定冲突
  • 仅复制筛选后的可见单元格，减少无效数据复制
  • 确保在任何场景下（包括出错）都能关闭文件、恢复Excel状态，避免异常

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