如何将数据从一个工作表传输到不相邻的空单元格？

编程语言 2026-07-11

我对VBA还很陌生，正在尝试用一种非常特定的方式来格式化数据。

大部分功能已经实现，除了最后一步。

我想把Sheet1的 G列中的系统名称传送到Sheet2的空白单元格中，来自Sheet1 (image 1)
到Sheet2的空白单元格 (image 2)
同时在检测到Sheet2的 A列有两个连续空单元格时结束。此外，我还想在数据传输完成后，在上方插入一个空行
(image 3) .
到目前为止，我写的代码只涉及到上述所述的前半部分。

之所以范围参数会这样设，是因为在工作表1中输入的数据大小每次都不同。我把它们设定为我认为足以覆盖全部数据的大小。

当我输入下面的代码时，结果如图4所示。``` Sub SystemName()

Dim LastRow, LRow As Long Dim Rng As Range Set Rng = Sheet2.Range("A3:A1500")

On Error Resume Next

With Sheet2
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 1 To LastRow
    For Each cell In Rng
        If IsEmpty(cell.Value) = True Then
    cell.Value = Sheet1.Range("G1:G250").Value

        End If
    Next

    Next

End With

End Sub


我真的很努力想靠自己把整件事都做完，但我觉得我得认输啦，lol。

## 解决方案

下面的代码使用 2 个计数器，一个用于 `Sheet2` 的行数，一个用于 `column G` 在 `Sheet1` 上的位置，其中放置系统名称。  
`Do While` 循环会检查 `Sheet2 Column A` 的连续单元格是否非空，然后再进行插入。```
Sub SystemName()

'Dim LastRow, LRow As Long
'Dim Rng As Range
'Set Rng = Sheet2.Range("A3:A1500")

'On Error Resume Next

Dim pointer As Long, rowcnt As Long

pointer = 1
rowcnt = 2
    With Sheet2
        'LastRow = Cells(.Rows.Count, 1).End(xlUp).Row
        Do While IsEmpty(.Cells(rowcnt, 1)) <> True Or IsEmpty(.Cells(rowcnt + 1, 1)) <> True
            If IsEmpty(.Cells(rowcnt, 1)) = True Then
                .Cells(rowcnt, 1) = Sheet1.Range("G" & pointer).Value
                pointer = pointer + 1
                .Cells(rowcnt, 1).EntireRow.Insert xlDown
                rowcnt = rowcnt + 1
            End If
        rowcnt = rowcnt + 1
        Loop
    End With

End Sub

Excel