Excel VBA代码问题：按单元格灰色底色复制行时startrow始终为0

核心问题分析 #

1. With块单元格引用错误
   你用With ActiveSheet.Range("C3:C" & lastrow)定义了从C3开始的范围，但后续.Cells(rownum, 3)的行号是相对于这个范围的相对位置，不是工作表的绝对行号。比如工作表第3行在这个With块里是第1行，第13行是第11行。直接用工作表的rownum去索引With块里的Cells，会定位到错误的单元格，根本识别不到灰色，导致startrow始终为初始值0。

2. 嵌套循环逻辑冲突
   For循环和Do循环同时修改rownum，遍历顺序混乱，可能直接跳过了首个灰色单元格的判断逻辑，startrow从未被赋值。

3. 末尾边界处理缺失
   如果表格最后一行不是灰色单元格，最后一段内容会被遗漏。

修正后的代码 #

Sub CopyGrayBlock()
    Dim startRow As Long, endRow As Long
    Dim lastRow As Long
    Dim ws As Worksheet
    
    Set ws = ActiveSheet
    lastRow = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
    startRow = 0
    
    ' 从第3行开始遍历C列
    Dim i As Long
    For i = 3 To lastRow
        ' 寻找第一个灰色单元格作为起始行
        If startRow = 0 And ws.Cells(i, 3).Interior.Color = RGB(191, 191, 191) Then
            startRow = i
        ' 找到下一个灰色单元格，确定结束行并复制
        ElseIf startRow <> 0 And ws.Cells(i, 3).Interior.Color = RGB(191, 191, 191) Then
            endRow = i - 1 ' 结束行是当前灰色行的上一行
            ' 复制从startRow到endRow的B列到Q列
            ws.Range(ws.Cells(startRow, 2), ws.Cells(endRow, 17)).Copy
            ' 粘贴到Result表的下一个空行
            Dim targetWs As Worksheet
            Set targetWs = ThisWorkbook.Sheets("Result")
            targetWs.Range("A" & targetWs.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
            startRow = i ' 更新起始行为当前灰色行，准备下一段
        End If
    Next i
    
    ' 处理最后一段（如果最后一行不是灰色单元格）
    If startRow <> 0 And startRow <= lastRow Then
        endRow = lastRow
        ws.Range(ws.Cells(startRow, 2), ws.Cells(endRow, 17)).Copy
        Dim targetWsLast As Worksheet
        Set targetWsLast = ThisWorkbook.Sheets("Result")
        targetWsLast.Range("A" & targetWsLast.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
    End If
    
    Application.CutCopyMode = False ' 清除复制状态
End Sub

关键修改说明 #

• 移除混乱嵌套循环：改用单循环遍历，逻辑清晰，避免rownum被多次修改导致的错误。
• 修正单元格引用：直接使用工作表绝对引用ws.Cells(i, 3)，避免With块相对索引的混淆。
• 添加边界处理：覆盖表格最后一段未到下一个灰色单元格的内容。
• 明确对象引用：指定工作表对象ws，避免ActiveSheet切换引发的错误。
• 优化粘贴逻辑：自动定位Result表的下一个空行，替代低效的手动Select操作。

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