VBA根据指定单元格值循环复制粘贴行的代码精简方法

你的现有代码存在两个核心效率问题：一是反复通过Activate切换工作表，属于VBA编程里的低效写法；二是通过硬编码逐次判断复制次数，场景扩展性极差。用循环+直接对象引用的写法，仅需十几行代码即可支持任意次数的复制需求，运行效率远高于原有写法。

实现逻辑说明 #

• 完全对齐原有代码规则：Sheet1中D23单元格值为N时，需要将Sheet2的14:24行共复制N-1次
• 保持原有粘贴格式：第一次粘贴从26行开始，每块粘贴内容占11行（和源区域14:24行的行数一致），两块内容之间空1行，每次粘贴位置自动偏移12行
• 全程不需要激活切换工作表，直接操作工作表对象，复制50次也可瞬间完成
• 增加基础合法性校验，避免D23输入非法值导致代码报错

完整可直接运行的代码 #

Sub BatchCopyRows()
    Dim wsSourceData As Worksheet, wsOperation As Worksheet
    Dim copyCount As Long, i As Long
    Dim pasteStartRow As Long, sourceRowRange As Range
    
    ' 绑定工作表，注意如果你的工作表名带空格（比如"Sheet 1"），请修改引号内的名称
    Set wsSourceData = ThisWorkbook.Worksheets("Sheet1")
    Set wsOperation = ThisWorkbook.Worksheets("Sheet2")
    
    ' 读取需要的复制次数，对齐原有逻辑：D23值减1为实际复制次数
    If Not IsNumeric(wsSourceData.Range("D23").Value) Then
        MsgBox "Sheet1的D23单元格请输入有效数字！"
        Exit Sub
    End If
    copyCount = wsSourceData.Range("D23").Value - 1
    If copyCount < 1 Then Exit Sub ' 数值小于2时不需要复制，直接退出
    
    ' 定义源区域和首次粘贴的起始行
    Set sourceRowRange = wsOperation.Rows("14:24")
    pasteStartRow = 26
    
    ' 循环复制，不需要逐次写判断逻辑
    Application.ScreenUpdating = False ' 关闭屏幕更新进一步提速
    For i = 1 To copyCount
        sourceRowRange.Copy wsOperation.Rows(pasteStartRow)
        pasteStartRow = pasteStartRow + 12 ' 偏移量=11行内容+1行空行间隔
    Next i
    Application.ScreenUpdating = True ' 恢复屏幕更新
    
    MsgBox "复制完成，共完成" & copyCount & "次粘贴！"
End Sub

使用注意事项 #

• 如果你的实际工作表名称是带空格的（比如原有代码里写的Sheet 1），只需要修改代码中Worksheets()括号内的表名即可
• 如果不需要粘贴块之间留空行，把代码里的行偏移量从12改成11即可
• 如果需要调整首次粘贴的起始位置，直接修改pasteStartRow的初始值即可

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