VBA打开CSV文件复制指定区域至已有工作簿报错及优化咨询

错误原因 #

执行Set sourceworkbook = Workbooks(FileToOpen)时报下标越界，是因为Application.GetOpenFilename返回的是文件完整路径，而Workbooks()集合只能通过已打开工作簿的名称或索引来引用，此时选中的.csv文件还未打开，自然找不到对应项，触发错误。

优化实现代码 #

以下是修复错误并优化后的代码，去掉了冗余的Select/Activate操作，增加了取消选择的判断，逻辑更稳定高效：

Private Sub CommandButton1_Click()
    Dim fileToOpen As Variant
    Dim sourceWb As Workbook
    Dim targetWs As Worksheet
    
    ' 获取.csv文件路径，处理用户取消选择的情况
    fileToOpen = Application.GetOpenFilename( _
        Title:="选择CSV文件", _
        FileFilter:="CSV文件 (*.csv), *.csv")
    
    If fileToOpen = False Then Exit Sub ' 用户取消选择，直接退出
    
    Set targetWs = ThisWorkbook.Worksheets("Sheet1") ' 目标工作表
    
    ' 打开源CSV文件，获取工作簿对象
    Set sourceWb = Workbooks.Open(fileToOpen)
    
    ' 直接复制指定区域到目标位置，无需激活/选择
    sourceWb.Worksheets(1).Range("B4:F4").Copy _
        Destination:=targetWs.Range("B14")
    
    ' 关闭源工作簿，不保存更改
    sourceWb.Close SaveChanges:=False
    
    ' 释放对象
    Set sourceWb = Nothing
    Set targetWs = Nothing
    
    ' 可选：定位到目标单元格
    targetWs.Activate
    targetWs.Range("B14").Select
End Sub

优化要点 #

• 处理取消选择：增加If fileToOpen = False Then Exit Sub，避免用户取消选择后代码继续执行报错
• 避免Select/Activate：直接通过工作表和单元格对象引用操作，减少Excel界面交互，提升代码运行速度和稳定性
• 简化复制逻辑：使用Copy Destination:=直接指定目标区域，一步完成复制粘贴
• 明确关闭参数：关闭源工作簿时指定SaveChanges:=False，避免弹出保存提示框

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