如何用 VBA 将另一工作表的数据依次填入不连续空白单元格？

2026-11-04数据小许

处理方法

先记录 Sheet2 A 列中需要填充的行号，再从下往上写入系统名称并插入空白行。系统名称仍按 Sheet1 G 列从上到下的顺序对应目标位置。

需要先判断空白位置。如果边扫描边插入行，新插入的空白行会改变行号，还可能干扰“连续两个空白就停止”的判断。

由于没有提供截图，下面根据现有代码作以下约定：

来源是 Sheet1 的 G 列，从 G1 开始，跳过真正的空单元格。
目标是 Sheet2 的 A 列，从 A3 开始。
遇到原始数据中连续两个空白单元格时停止，这两个单元格都不填充。
每填充一个系统名称，就在其所在行上方插入一个整行。

原代码的问题

下面的语句不能实现逐项对应填充：

cell.Value = Sheet1.Range("G1:G250").Value

左侧是一个单元格，右侧是多单元格范围返回的二维数组。代码没有指定当前应取 G 列中的哪一个名称，因此无法让名称与目标空白单元格按顺序对应。

另外还有几个问题：

外层 For i = 1 To LastRow 没有使用 i，只是在重复扫描同一范围。
没有检查连续两个空白单元格。
On Error Resume Next 会忽略运行错误，不利于定位问题。
Dim LastRow, LRow As Long 中只有 LRow 是 Long，LastRow 实际上是 Variant。

可用的 VBA 示例

下面使用 Sheet1、Sheet2 作为工作表的 CodeName，与原代码保持一致。

Option Explicit

Sub SystemName()
    Const SOURCE_START_ROW As Long = 1
    Const TARGET_START_ROW As Long = 3

    Dim wsSrc As Worksheet
    Dim wsDst As Worksheet
    Dim names As Collection
    Dim targets As Collection
    Dim lastSourceRow As Long
    Dim r As Long
    Dim i As Long
    Dim transferCount As Long

    Set wsSrc = Sheet1
    Set wsDst = Sheet2
    Set names = New Collection
    Set targets = New Collection

    ' Read source names in their original order.
    lastSourceRow = wsSrc.Cells(wsSrc.Rows.Count, 7).End(xlUp).Row

    For r = SOURCE_START_ROW To lastSourceRow
        If Not IsEmpty(wsSrc.Cells(r, 7).Value2) Then
            names.Add wsSrc.Cells(r, 7).Value2
        End If
    Next r

    If names.Count = 0 Then
        MsgBox "No source names found."
        Exit Sub
    End If

    ' Find target rows before changing any data or inserting rows.
    For r = TARGET_START_ROW To wsDst.Rows.Count
        If IsEmpty(wsDst.Cells(r, 1).Value2) Then
            If r < wsDst.Rows.Count Then
                If IsEmpty(wsDst.Cells(r + 1, 1).Value2) Then
                    Exit For
                End If
            End If

            targets.Add r
        End If
    Next r

    transferCount = names.Count
    If targets.Count < transferCount Then
        transferCount = targets.Count
    End If

    If transferCount = 0 Then
        MsgBox "No target blank cells found before the stopping point."
        Exit Sub
    End If

    ' Work upward so inserted rows do not invalidate earlier targets.
    For i = transferCount To 1 Step -1
        r = CLng(targets(i))
        wsDst.Cells(r, 1).Value2 = names(i)
        wsDst.Rows(r).Insert Shift:=xlDown
    Next i

    MsgBox "Transferred: " & transferCount & vbCrLf & _
           "Source names remaining: " & (names.Count - transferCount)
End Sub

代码先按顺序收集名称和目标行号，再让 names(i) 对应 targets(i)。写入时虽然从下往上处理，名称仍按原顺序排列。

写入名称后，Rows(r).Insert 会在当前行上方插入整行，名称随原行移动到下一行。接下来处理更靠上的目标，不会用到因插行而改变的下方行号。

如果停止点之前的目标位置不足，代码只填充能容纳的名称，并提示剩余数量；如果名称先用完，则停止写入，保留其他目标空白位置。

使用前需要确认的细节

如果 G1 是表头，应将 SOURCE_START_ROW 改为 2，否则表头也会被当作系统名称。

示例沿用原代码的 IsEmpty，只把真正没有内容的单元格视为空白。包含空格的单元格，以及公式返回 "" 的单元格，都不会被判为空白。如果实际数据需要把这些情况也算作空白，应统一修改来源筛选和目标停止条件。

wsDst.Rows(r).Insert 会插入整行，移动 Sheet2 其他列的内容。只有其他列也需要随行移动时，才适合使用这种方式；单独在 A 列插入单元格可能破坏原有行对应关系。

运行前请保留原始数据副本。这段宏会写入数据并插入行，没有针对重复执行设计去重逻辑。验证布局时，应从同一份原始数据开始运行。