Excel VBA按条件复制行至指定工作表的问题排查与扩展

原代码存在的问题 #

• 复制范围逻辑错误：Range("A2:P" & LR).Rows(i)的写法会选中从A2到P列最后一行的整个区域的第i行，并非当前循环行的A-P列，导致错误复制内容
• 粘贴位置固定：每次都粘贴到Sheet2的A2单元格，会覆盖之前复制的内容，无法保留所有符合条件的行
• 未实现"Auto"行复制到Sheet3的需求
• 频繁使用Select/Activate，不仅效率低，还容易因工作表切换触发错误

修正后的代码 #

Private Sub CommandButton1_Click()
    Dim wsSource As Worksheet
    Dim wsManual As Worksheet
    Dim wsAuto As Worksheet
    Dim lastRowSource As Long
    Dim lastRowManual As Long
    Dim lastRowAuto As Long
    Dim i As Long
    
    ' 绑定工作表对象，避免Select/Activate操作
    Set wsSource = ThisWorkbook.Sheets("Paste Data")
    Set wsManual = ThisWorkbook.Sheets("Sheet2")
    Set wsAuto = ThisWorkbook.Sheets("Sheet3")
    
    ' 获取源表数据的最后一行
    lastRowSource = wsSource.Cells.Find("*", wsSource.Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
    
    ' 清空目标表原有数据（可选，若需要保留历史数据可注释此行）
    wsManual.Range("A2:P" & wsManual.Cells(wsManual.Rows.Count, "A").End(xlUp).Row).ClearContents
    wsAuto.Range("A2:P" & wsAuto.Cells(wsAuto.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    ' 遍历源表数据行，按条件复制
    For i = 2 To lastRowSource
        Select Case wsSource.Cells(i, 21).Value ' 21对应U列
            Case "Manual"
                ' 获取Sheet2的最后一行，粘贴到下一行
                lastRowManual = wsManual.Cells(wsManual.Rows.Count, "A").End(xlUp).Row + 1
                wsSource.Range("A" & i & ":P" & i).Copy wsManual.Range("A" & lastRowManual)
            Case "Auto"
                ' 获取Sheet3的最后一行，粘贴到下一行
                lastRowAuto = wsAuto.Cells(wsAuto.Rows.Count, "A").End(xlUp).Row + 1
                wsSource.Range("A" & i & ":P" & i).Copy wsAuto.Range("A" & lastRowAuto)
        End Select
    Next i
    
    ' 自动调整目标表的列宽
    wsManual.Columns("A:P").AutoFit
    wsAuto.Columns("A:P").AutoFit
    
    ' 清理剪贴板
    Application.CutCopyMode = False
End Sub

代码关键优化点 #

• 使用工作表对象绑定替代Select/Activate，提升代码稳定性和执行效率
• 精准定位当前循环行的A-P列进行复制，避免范围错误
• 动态获取目标表的最后一行，确保新数据粘贴到空行，不会覆盖原有内容
• 通过Select Case统一处理两种判断条件，逻辑更清晰
• 可选清空目标表原有数据，若需要保留历史数据可删除对应的清空代码行

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