VBA批量生成产品价目表仅输出首条数据，求排查解决

问题原因 #

核心问题是**FirstRow变量未在循环中更新**：初始设置FirstRow = 1后，每次循环都从第1行开始写入数据，后续商品的内容会直接覆盖之前的结果，最终只会保留最后一次循环的内容（若你看到仅显示第一条，大概率是后续商品的基础成本与第一条一致，或循环中未正确覆盖）。原代码中虽计算了LastRow，但并未将其赋值给FirstRow，导致下一次循环仍从第1行开始写入。

修正后的代码（高效版） #

Sub PriceCopy()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim Lastrows As Long, i As Long
    Dim ItemCode As String
    Dim Price As Double
    Dim nextRow As Long ' 跟踪目标表下一个写入的起始行
        
    Set wsSource = ThisWorkbook.Worksheets("Sheet6")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet5")
        
    Lastrows = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    nextRow = 1 ' 初始起始行设为1
    
    For i = 1 To Lastrows
        ItemCode = wsSource.Range("A" & i).Value
        Price = wsSource.Range("C" & i).Value
        
        ' 写入当前商品的4层级价格数据
        wsTarget.Range("A" & nextRow).Value = ItemCode
        wsTarget.Range("A" & nextRow + 1).Value = ItemCode
        wsTarget.Range("A" & nextRow + 2).Value = ItemCode
        wsTarget.Range("A" & nextRow + 3).Value = ItemCode

        wsTarget.Range("B" & nextRow).Value = 1
        wsTarget.Range("B" & nextRow + 1).Value = 2
        wsTarget.Range("B" & nextRow + 2).Value = 3
        wsTarget.Range("B" & nextRow + 3).Value = 4

        wsTarget.Range("C" & nextRow).Value = Price + 1
        wsTarget.Range("C" & nextRow + 1).Value = Price + 1.1
        wsTarget.Range("C" & nextRow + 2).Value = Price + 1.2
        wsTarget.Range("C" & nextRow + 3).Value = Price + 1.3

        ' 更新下一次写入的起始行：每个商品占4行，直接+4
        nextRow = nextRow + 4
    Next i
End Sub

兼容版代码（支持目标表已有数据） #

如果目标表Sheet5原本已有数据，可改用以下方式自动获取空白行，避免覆盖原有内容：

Sub PriceCopy()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim Lastrows As Long, i As Long
    Dim ItemCode As String
    Dim Price As Double
    Dim nextRow As Long
        
    Set wsSource = ThisWorkbook.Worksheets("Sheet6")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet5")
        
    Lastrows = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    For i = 1 To Lastrows
        ' 获取目标表下一个空白行的行号
        nextRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
        ' 处理目标表为空的情况
        If nextRow = 1 And wsTarget.Range("A1").Value = "" Then
            nextRow = 1
        Else
            nextRow = nextRow + 1
        End If
        
        ItemCode = wsSource.Range("A" & i).Value
        Price = wsSource.Range("C" & i).Value
        
        wsTarget.Range("A" & nextRow).Value = ItemCode
        wsTarget.Range("A" & nextRow + 1).Value = ItemCode
        wsTarget.Range("A" & nextRow + 2).Value = ItemCode
        wsTarget.Range("A" & nextRow + 3).Value = ItemCode

        wsTarget.Range("B" & nextRow).Value = 1
        wsTarget.Range("B" & nextRow + 1).Value = 2
        wsTarget.Range("B" & nextRow + 2).Value = 3
        wsTarget.Range("B" & nextRow + 3).Value = 4

        wsTarget.Range("C" & nextRow).Value = Price + 1
        wsTarget.Range("C" & nextRow + 1).Value = Price + 1.1
        wsTarget.Range("C" & nextRow + 2).Value = Price + 1.2
        wsTarget.Range("C" & nextRow + 3).Value = Price + 1.3
    Next i
End Sub

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