如何在VBA循环中实现行变量递增，完成单元格批量复制？

作为VBA新手，我正在开发报表功能，需要把Excel「CS15」工作表中的特定单元格复制到名为「Report」的新工作表。目前遇到的问题是：怎么让行变量自动递增1，依次检查B3、B4、B5……单元格，并把符合条件的内容复制到Report工作表对应的B3、B4、B5……位置？

我的原始代码如下：

Sub CopyRow()

'Return to Sheets("CS15 Download"), Find Last Row and LastRow = that row
    Sheets("CS15").Select
    Range("A8").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.End(xlUp).Select
    LastRow = ActiveCell.Row
    
    
Dim ObjDes As Variant
Const Lvl As Integer = 1

ObjDes = Range("Q1").Value

'Variables to be copied
Dim ComNum As Integer
ComNum = Range("F3").Value
Dim Description As Variant
Description = Range("G3").Value

'Target Cells in Report Sheet
Dim ReportComNum As Integer
ReportComNum = Sheets("Report").Range("B2")
Dim ReportDescription As Variant
ReportDescription = Sheets("Report").Range("C2")


'Variables to Check
Dim Level As Variant
Level = Range("B3").Value

'Select the first Component Number
Range(ComNum).Select

'Do Until LastRow is reached
Do While ActiveCell.Row < LastRow + 1

'If the Level Is 1 Then
If Range("B3").Value = Lvl Then
    
    'Copy the ComNum and Description into B2/C2 of Report Sheet
    ReportComNum.Value = Range(ComNum).Value
    ReportDescription.Value = Range(Description).Value
    'Select Next Row
    ActiveCell.Offset(1, 0).Range("A1").Select

'If Level is not 1, but the ObjDes starts with "BDS" Then
ElseIf Range("B3").Value > Lvl And InStr(1, ObjDes, "BDS") = 1 Then

    'Copy the ComNum and Description into B2/C2 of Report Sheet
    ReportComNum.Value = Range(ComNum).Value
    ReportDescription.Value = Range(Description).Value
    'Select Next Row
    ActiveCell.Offset(1, 0).Range("A1").Select
        
'If not, go to next row
Else
ActiveCell.Offset(1, 0).Range("A1").Select

End If

Loop

End Sub

问题分析与修正方案 #

你的代码核心问题在于没有用动态行变量遍历单元格，一直固定检查B3，而且用了大量Select操作（VBA里尽量避免，容易出错且效率低），同时变量类型定义错误（比如把单元格对象当成数值存储）。

下面是修改后的代码，直接用循环变量i控制行号，实现自动递增，同时优化了逻辑：

Sub CopyToReport()
    Dim wsSource As Worksheet
    Dim wsReport As Worksheet
    Dim LastRow As Long
    Dim i As Long
    Dim targetRow As Long
    Dim ObjDes As Variant
    Const Lvl As Integer = 1
    
    ' 定义源工作表和目标工作表，避免反复切换选择
    Set wsSource = ThisWorkbook.Sheets("CS15")
    Set wsReport = ThisWorkbook.Sheets("Report")
    
    ' 更可靠的获取B列最后一行数据的行号
    LastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    
    ObjDes = wsSource.Range("Q1").Value
    targetRow = 3 ' 从Report的B3开始写入
    
    ' 从第3行开始遍历到最后一行
    For i = 3 To LastRow
        ' 检查当前行的Level值
        If wsSource.Cells(i, "B").Value = Lvl Then
            ' 复制F列和G列内容到Report对应行
            wsReport.Cells(targetRow, "B").Value = wsSource.Cells(i, "F").Value
            wsReport.Cells(targetRow, "C").Value = wsSource.Cells(i, "G").Value
            targetRow = targetRow + 1 ' 目标行递增
        ElseIf wsSource.Cells(i, "B").Value > Lvl And InStr(1, ObjDes, "BDS") = 1 Then
            ' 符合BDS前缀条件时复制
            wsReport.Cells(targetRow, "B").Value = wsSource.Cells(i, "F").Value
            wsReport.Cells(targetRow, "C").Value = wsSource.Cells(i, "G").Value
            targetRow = targetRow + 1
        End If
        ' 不符合条件则跳过，自动进入下一行循环
    Next i
End Sub

关键改进点 #

• 用循环变量i遍历行：从3开始到LastRow，自动递增，实现依次检查B3、B4...
• 避免Select操作：直接通过工作表对象引用单元格，代码更稳定高效
• 动态目标行控制：用targetRow变量记录Report工作表的写入位置，符合条件就递增
• 修正变量逻辑：直接引用单元格对象，不再错误地把单元格值当成变量存储
• 简化LastRow获取：用Cells(Rows.Count, "B").End(xlUp).Row直接获取B列最后一行，比多次Select更可靠

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