手动选择主表区域复制至另一工作簿的VBA代码问题

我来帮你解决这个VBA报错的问题，先梳理下原代码里的几个关键问题：

• 原代码用Workbooks.Open去打开已经处于打开状态的主工作簿MasterDATABASE.xlsm，这会触发报错（Excel不允许重复打开同一个文件）
• 对选中区域的引用方式有误：copyRng.Range("A1")是相对于选中区域的A1单元格，而非原工作表的A1，如果你的选中区域不是从A1开始，这会导致引用错位；同理copyRng.Range("B:B")这种写法会错误地引用整列，而非选中区域内的对应列
• 没有处理目标工作簿可能已打开的情况，重复打开也会报错

接下来是修正后的代码，我会加上详细注释：

Sub CopySelectedRangeToProforma()
    Dim masterWB As Workbook
    Dim targetWB As Workbook
    Dim copyRng As Range
    Dim targetSheet As Worksheet
    
    '---------- 1. 获取已打开的工作簿 ----------
    ' 主工作簿已打开，直接通过工作簿名称获取
    On Error Resume Next ' 防止工作簿未打开时报错
    Set masterWB = Workbooks("MasterDATABASE.xlsm")
    On Error GoTo 0
    
    If masterWB Is Nothing Then
        MsgBox "主工作簿 MasterDATABASE.xlsm 未打开，请先打开它！", vbExclamation
        Exit Sub
    End If
    
    ' 获取目标工作簿，优先找已打开的，没打开再尝试打开
    On Error Resume Next
    Set targetWB = Workbooks("Proforma.xlsm")
    On Error GoTo 0
    
    If targetWB Is Nothing Then
        ' 如果目标工作簿未打开，再尝试打开
        On Error Resume Next
        Set targetWB = Workbooks.Open("C:\Users\Jakub\Desktop\Proforma.xlsm")
        On Error GoTo 0
        
        If targetWB Is Nothing Then
            MsgBox "无法打开目标工作簿 Proforma.xlsm，请检查路径是否正确！", vbCritical
            Exit Sub
        End If
    End If
    
    ' 获取目标工作表
    Set targetSheet = targetWB.Sheets("proforma")
    
    '---------- 2. 让用户选择要复制的区域 ----------
    On Error Resume Next ' 如果用户取消选择，避免报错
    Set copyRng = Application.InputBox(Prompt:="请选择要复制的区域", Title:="选择复制范围", Type:=8)
    On Error GoTo 0
    
    If copyRng Is Nothing Then
        MsgBox "你取消了区域选择！", vbInformation
        Exit Sub
    End If
    
    '---------- 3. 执行复制粘贴操作 ----------
    ' 复制选中区域的第1行第1列单元格到目标B2
    copyRng.Cells(1, 1).Copy Destination:=targetSheet.Range("B2")
    ' 复制选中区域的第1行第3列单元格到目标B3
    copyRng.Cells(1, 3).Copy Destination:=targetSheet.Range("B3")
    ' 复制选中区域的第1行第4列单元格到目标B4
    copyRng.Cells(1, 4).Copy Destination:=targetSheet.Range("B4")
    ' 复制选中区域的第2列（对应原表B列）到目标A10开始的位置
    copyRng.Columns(2).Copy Destination:=targetSheet.Range("A10")
    ' 复制选中区域的第5列（对应原表E列）到目标C10开始的位置
    copyRng.Columns(5).Copy Destination:=targetSheet.Range("C10")
    
    MsgBox "数据复制完成！", vbInformation
End Sub

关键改动说明 #

• 工作簿获取逻辑：先尝试从已打开的工作簿集合中获取，避免重复打开导致报错；同时增加了错误判断，确保工作簿存在或路径正确
• 区域引用优化：用copyRng.Cells(行号, 列号)和copyRng.Columns(列序号)来引用选中区域内的单元格/列，彻底解决相对引用错位的问题
• 用户体验升级：增加了取消选择、工作簿未找到的提示，让操作过程更清晰友好

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