VBA实现仅粘贴值至另一工作表空白最后行的问题求助

你的核心问题是每次粘贴都固定指向A2位置导致覆盖，下面是修改后的代码，实现将数据追加到目标表最后一行空白处，同时保留仅粘贴值、清理空行/值为0的行的功能：

Sub CopyValuesOnly()
    On Error GoTo errHandler
    Application.ScreenUpdating = False ' 关闭屏幕刷新，提升运行速度
    Application.CutCopyMode = False

    Dim sourceWs As Worksheet, dstWs As Worksheet
    Dim srcRange As Range
    Dim dstLastRow As Long
    Dim i As Long
    Dim targetColumn As String
    
    targetColumn = "E"
    
    Set sourceWs = Sheets("Jammed")
    Set dstWs = Sheets("Monthly")
    Set srcRange = sourceWs.Range("A4:E53") ' 定义源数据区域

    ' 找到目标表E列最后一行有数据的行，下一行就是粘贴起始行
    dstLastRow = dstWs.Cells(dstWs.Rows.Count, targetColumn).End(xlUp).Row + 1

    ' 直接赋值（仅粘贴值，无需依赖剪贴板）
    dstWs.Range("A" & dstLastRow).Resize(srcRange.Rows.Count, srcRange.Columns.Count).Value = srcRange.Value

    ' 清理E列为空或值为0的行（从最后一行往上删，避免索引错乱）
    For i = dstWs.Cells(dstWs.Rows.Count, targetColumn).End(xlUp).Row To 1 Step -1
        If dstWs.Cells(i, targetColumn).Value = 0 Or IsEmpty(dstWs.Cells(i, targetColumn).Value) Then
            dstWs.Rows(i).Delete
        End If
    Next i

    dstWs.Cells.EntireColumn.AutoFit

exitHandler:
    Application.ScreenUpdating = True ' 恢复屏幕刷新
    Application.CutCopyMode = False
    Exit Sub

errHandler:
    MsgBox "数据复制失败：" & Err.Description ' 增加错误描述，便于排查问题
    Resume exitHandler
End Sub

关键修改说明 #

• 避免覆盖：通过dstWs.Cells(dstWs.Rows.Count, targetColumn).End(xlUp).Row + 1计算出目标表的下一个空白行，作为粘贴起始位置
• 高效赋值：用直接赋值替代Copy/PasteSpecial，不需要依赖剪贴板，运行更快且更稳定
• 优化性能：添加Application.ScreenUpdating = False关闭屏幕刷新，减少运行时的卡顿
• 错误排查：修改错误提示，显示具体错误信息，方便定位问题

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