VBA代码异常：无法将源表Product数据导入目标表Item列

问题背景 #

需要将源工作表（Sheet1）的数据按列格式迁移至目标工作表（Sheet2），但现有VBA代码无法正常将源表中“Product:”对应的数据导入目标表的Item列（第2列）。

原问题代码 #

Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Dim Counter As Integer
Dim Lastrow As Long
Dim Invoice As Long
Dim Item As Long
Dim Qty As Long

Set Sheet1 = Worksheets("Sheet1")
Set Sheet2 = Worksheets("Sheet2")

For Counter = 1 To Lastrow
If Sheet1.Cells(Counter,1).Value = "Product:" Then
  Sheet1.Cells(Counter,2).Copy
  Sheet2.Activate
  Item = Sheet2.Cells(Rows.Count,2).End(xlUp).Row + 1
  Sheet2.Cells(Item,2).Select
  ActiveSheet.Paste
  Sheet1.Activate
ElseIf Left(Sheet1.Cells(Counter,1).Value,3) = "INV" Then
  Sheet1.Cells(Counter,1).Copy
  Sheet2.Activate
  Invoice = Sheet2.Cells(Rows.Count,1).End(xlUp).Row + 1
  Sheet2.Cells(Invoice,1).Select
  ActiveSheet.Paste
  Sheet1.Activate
  Sheet1.Cells(Counter,2).Copy
  Sheet2.Activate
  Qty = Sheet2.Cells(Rows.Count,3).End(xlUp).Row + 1
  Sheet2.Cells(Qty,3).Select
  ActiveSheet.Paste
  Sheet1.Activate
End If
Next Counter

问题分析 #

1. 核心变量未初始化：代码仅定义了Lastrow但未赋值，导致循环For Counter = 1 To Lastrow完全无法执行，这是Product数据无法导入的根本原因。
2. 冗余操作引发错误：频繁使用Activate和Select切换工作表、选择单元格，不仅效率低下，还容易因工作表焦点变化触发运行时错误。
3. 数据关联逻辑缺失：原代码未处理Product与对应Invoice的绑定关系，可能导致数据错位（默认每个Product属于上方最近的Invoice）。

修复后的代码 #

Sub MigrateData()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRowSource As Long
    Dim lastRowDest As Long
    Dim currentInv As String
    Dim i As Long
    
    ' 设置源表和目标表对象
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    Set wsDest = ThisWorkbook.Worksheets("Sheet2")
    
    ' 获取源表最后一行的行号
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    
    ' 遍历源表所有数据行
    For i = 1 To lastRowSource
        ' 捕获当前Invoice编号并写入目标表
        If Left(wsSource.Cells(i, 1).Value, 3) = "INV" Then
            currentInv = wsSource.Cells(i, 1).Value
            lastRowDest = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row + 1
            wsDest.Cells(lastRowDest, 1).Value = currentInv
            wsDest.Cells(lastRowDest, 3).Value = wsSource.Cells(i, 2).Value
        ' 将Product数据写入对应Invoice的同一行
        ElseIf wsSource.Cells(i, 1).Value = "Product:" Then
            lastRowDest = wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Row
            wsDest.Cells(lastRowDest, 2).Value = wsSource.Cells(i, 2).Value
        End If
    Next i
End Sub

修复说明 #

1. 初始化关键变量：添加lastRowSource = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row，确保循环能遍历源表所有有效数据。
2. 移除冗余操作：直接通过工作表对象读写单元格值，避免焦点切换错误，同时提升代码运行效率。
3. 补全数据关联逻辑：记录当前Invoice编号，将后续的Product数据写入目标表对应Invoice的同一行，保证数据对应关系准确。
4. 优化变量命名：使用wsSource、wsDest等语义化变量名，提升代码可读性。

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