运行VBA While循环时Excel崩溃，如何批量复制同批次表格行？

• 核心原因是死循环：Do循环内每次都给nextRow赋值为StartRow + 1，而StartRow从未更新，所以nextRow永远是同一个固定值。如果当前行的下一行批次与目标Batch一致，循环终止条件永远无法触发，程序无限运行导致Excel无响应崩溃。
• 缺少边界校验：未限制遍历的最大行，当批次覆盖到工作表最后一行时，代码会持续读取工作表外的空单元格，进一步加重运行异常风险。
• 列范围计算逻辑不合理：从C7单元格开始向右取最右列，如果C7右侧存在空值或者表格起始行不是第7行，会导致选中的列范围异常，甚至选中整行超大范围，也可能引发崩溃。

Sub CopySameBatchRows()
    Dim targetWs As Worksheet
    Dim maxValidRow As Long, startRow As Long, currentRow As Long, lastCol As Long
    Dim targetBatch As Variant
    
    ' 绑定当前活动工作表，避免跨表操作错误
    Set targetWs = ActiveSheet
    ' 获取第一列的最大有效行，限制遍历边界
    maxValidRow = targetWs.Cells(targetWs.Rows.Count, 1).End(xlUp).Row
    ' 读取当前选中的行作为起始行
    startRow = ActiveCell.Row
    ' 读取目标批次号
    targetBatch = targetWs.Cells(startRow, 1).Value
    ' 从表头行（这里默认表头在第1行，可根据实际调整）计算表格最右列
    lastCol = targetWs.Cells(1, targetWs.Columns.Count).End(xlToLeft).Column
    
    ' 从起始行下一行开始遍历
    currentRow = startRow + 1
    ' 遍历到批次变化或者到达最大有效行即停止
    Do While currentRow <= maxValidRow And targetWs.Cells(currentRow, 1).Value = targetBatch
        currentRow = currentRow + 1
    Loop
    
    ' 计算需要复制的总行数
    Dim copyRowsCount As Long
    copyRowsCount = currentRow - startRow
    
    ' 选中对应批次的整行范围并复制
    targetWs.Range(targetWs.Cells(startRow, 1), targetWs.Cells(startRow + copyRowsCount - 1, lastCol)).Copy
End Sub

• 修复死循环问题：遍历的行号在循环内逐次递增，不会重复读取同一行单元格，确保循环一定会终止。
• 新增边界校验：提前计算表格的最大有效行，遍历不会超出表格范围，避免无意义的空单元格读取。
• 优化范围计算逻辑：从表头行计算最右列，适配不同结构的表格，不会出现范围错位问题。
• 明确绑定工作表对象：所有单元格操作都指定所属工作表，避免切换工作表时出现操作范围错误。

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