如何修改Excel VBA代码实现多选行批量复制删除至指定工作表

原代码依赖Select/Activate操作，不仅效率低，还只能处理单行。下面是修改后的代码，支持选中任意多行批量复制到目标工作表并删除原行：

Sub CopyToReturn()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim selectedRows As Range
    Dim targetLastRow As Long
    Dim i As Long
    
    ' 定义工作表对象，避免重复切换
    Set sourceSheet = ThisWorkbook.Sheets("DLS-Route")
    Set targetSheet = ThisWorkbook.Sheets("Return Source")
    
    ' 获取选中的行（如果没选中单元格，直接退出）
    On Error Resume Next
    Set selectedRows = Intersect(sourceSheet.UsedRange, Selection.EntireRow)
    On Error GoTo 0
    
    If selectedRows Is Nothing Then
        MsgBox "请先选中要处理的行！", vbExclamation
        Exit Sub
    End If
    
    ' 找到目标工作表的最后一行（避免空行导致的定位错误）
    targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
    
    ' 复制选中行到目标工作表的下一行
    selectedRows.Copy targetSheet.Cells(targetLastRow + 1, "A")
    
    ' 从下往上删除原行（避免删除时行号偏移导致漏删）
    For i = selectedRows.Areas.Count To 1 Step -1
        selectedRows.Areas(i).EntireRow.Delete
    Next i
End Sub

代码关键改进点： #

• 避免Select/Activate操作：直接通过工作表对象操作，减少切换工作表的开销，同时避免因选中区域变化导致的错误
• 兼容多行选中：用Intersect确保选中行在数据源的已用范围内，支持连续或不连续的多行选中
• 精准定位目标行：通过Rows.Count+End(xlUp)找到真正的最后一行，解决原代码中End(xlDown)遇到空行就停止的问题
• 正确删除多行：从下往上删除选中的行区域，防止删除上方行后下方行号偏移导致漏删

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