Excel宏开发求助：同工作表内表格行迁移后原行删除异常

原代码核心问题 #

1. 删除行逻辑错误：原代码用Selection.ListObject.ListRows(3).Delete固定删除表格第3行，而非用户选中的目标行，这是删除环节出错的直接原因。
2. 依赖Select/ActiveCell操作：这类操作易因工作表选中状态变化导致逻辑混乱，且代码冗余低效。
3. 目标表定位缺陷：若目标表无数据，End(xlDown)会跳到工作表末尾，导致粘贴位置错误。

修正后的代码 #

Sub Task_Done()
    Dim sourceTable As ListObject
    Dim targetTable As ListObject
    Dim selectedRow As ListRow
    Dim newTargetRow As ListRow
    
    ' 绑定原表格（Table2）和目标表格（Table6）
    Set sourceTable = ThisWorkbook.ActiveSheet.ListObjects("Table2")
    Set targetTable = ThisWorkbook.ActiveSheet.ListObjects("Table6")
    
    ' 校验选中单元格是否在原表格数据区内
    On Error Resume Next
    Set selectedRow = sourceTable.ListRows(Selection.Row - sourceTable.HeaderRowRange.Row)
    On Error GoTo 0
    
    If selectedRow Is Nothing Then
        MsgBox "请选择原表格（Table2）中的有效单元格。", vbCritical
        Exit Sub
    End If
    
    ' 目标表新增行并复制原行数据
    Set newTargetRow = targetTable.ListRows.Add(AlwaysInsert:=True)
    selectedRow.Range.Copy
    newTargetRow.Range.PasteSpecial Paste:=xlPasteValuesAndNumberFormats ' 可按需调整粘贴类型
    
    ' 删除原表格选中行
    selectedRow.Delete
    
    ' 清除剪贴板状态
    Application.CutCopyMode = False
End Sub

代码改进说明 #

• 直接通过ListObject对象操作表格，彻底摆脱对选中状态的依赖，逻辑更稳定。
• 精准定位选中的原表格行，删除操作不会出现偏差。
• 用ListRows.Add自动在目标表末尾新增行，无需手动计算位置。
• 支持自定义粘贴内容（比如仅粘贴值和格式），避免公式或格式冲突。
• 操作完成后清除剪贴板，优化用户体验。

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