如何快速复制粘贴Excel最后一行n次？优化VBA代码提速

原代码的问题 #

你的循环代码效率低下主要有三个原因：

• 循环内重复计算最后一行位置，每次复制后都重新查找，完全没必要
• 循环内部给n赋值3，会覆盖初始的循环次数，属于逻辑错误
• 逐行复制调用Excel剪贴板和界面更新，多次小操作拖慢整体速度

无需循环的高效写法（直接复制n次） #

可以一次性选中目标粘贴区域，完成复制粘贴操作，彻底避免循环，速度提升显著。以下是复制3次的示例代码：

Sub CopyLastRow3Times()
    Dim ws As Worksheet
    Dim lastRow As Long
    
    '指定目标工作表，可替换为你的工作表名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    '获取当前最后一行行号
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    '一次性复制最后一行，粘贴到下方3行的位置
    ws.Rows(lastRow).Copy ws.Rows(lastRow + 1 & ":" & lastRow + 3)
End Sub

如果需要复制任意次数n，只需把代码里的3替换为变量n即可。

通用效率优化技巧（复杂场景备用） #

如果处理更复杂的复制逻辑（比如需要修改每行内容），必须使用循环时，可通过关闭Excel的后台操作来提速：

Sub CopyLastRowNTimes_Efficient()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim n As Long
    
    n = 3 '可自定义复制次数
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    '关闭不必要的后台操作
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    '错误处理，确保后续恢复默认设置
    On Error GoTo RestoreSettings
    
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    ws.Rows(lastRow).Copy ws.Rows(lastRow + 1 & ":" & lastRow + n)
    
RestoreSettings:
    '恢复Excel默认设置
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
    '如果出错，提示错误信息
    If Err.Number <> 0 Then MsgBox "执行出错：" & Err.Description
End Sub

原理说明 #

一次性复制粘贴减少了VBA与Excel界面的交互次数，避免了循环中频繁的剪贴板调用和屏幕刷新，即使复制几百行也能瞬间完成。

内容的提问来源于stack exchange，提问作者Laura Gómez