Excel VBA宏异常排查：复制单元格及关联列至另一工作表

原代码问题分析 #

• 所有目标单元格固定为第1行（如B1、C1），无法匹配源单元格的对应行，导致仅能单次录入到第1行
• 存在未定义对象data（应为dataSheet），触发运行时错误，因On Error Resume Next被跳过，后续赋值操作未执行，直接导致B列无数据生成
• 复制的列与需求不符（原代码用H/D列，需求为E/V列）

修正后的完整代码 #

Sub CopyDataToTest()
    Dim sourceCell As Range
    Dim dataSheet As Worksheet
    Dim blankSheet As Worksheet
    
    ' 绑定Data和Blank工作表
    Set dataSheet = ThisWorkbook.Sheets("Data")
    Set blankSheet = ThisWorkbook.Sheets("Blank")
    
    ' 弹出选择框，允许用户选择Data表中的目标单元格
    On Error Resume Next
    Set sourceCell = Application.InputBox("请选择Data表中的目标单元格", "选择单元格", Type:=8)
    On Error GoTo 0
    
    ' 确认用户已选择有效单元格
    If Not sourceCell Is Nothing Then
        ' 将源单元格值复制到Blank表对应行的B列
        blankSheet.Cells(sourceCell.Row, "B").Value = sourceCell.Value
        
        ' 将Data表对应行的E列、V列数据复制到Blank表对应行的C列、D列
        blankSheet.Cells(sourceCell.Row, "C").Value = dataSheet.Cells(sourceCell.Row, 5).Value ' E列（索引5）
        blankSheet.Cells(sourceCell.Row, "D").Value = dataSheet.Cells(sourceCell.Row, 22).Value ' V列（索引22）
        
        ' 激活Blank表对应行的A列，方便重复操作
        blankSheet.Activate
        blankSheet.Cells(sourceCell.Row, "A").Select
    End If
End Sub

关键修改说明 #

1. 目标行匹配：用Cells(sourceCell.Row, "B")替代固定的Range("B1")，确保数据写入Blank表中与源单元格相同的行
2. 修复对象引用错误：将data.Cells修正为dataSheet.Cells，消除运行时错误，保证赋值操作正常执行
3. 列索引调整：将复制的列从H（索引8）、D（索引4）改为E（索引5）、V（索引22），匹配需求
4. 保留定位逻辑：操作后自动激活Blank表对应行的A列，支持逐行重复录入

快捷键设置方法 #

1. 打开Excel，点击顶部菜单栏的开发工具→宏
2. 在宏列表中选中CopyDataToTest，点击选项
3. 在快捷键输入框中按下Ctrl+Shift+W，点击确定即可生效

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