Excel VBA-如何在空白单元格后复制和粘贴数据组？

我在B6和M6中有直接对应的数据。数据来自B6:B12，然后在B13:B14中有两个空白单元格。然后数据从B15:B23开始，然后有两个空白单元格，该模式在页面下重复…（M列也是如此）

我研究了如何找到空白单元格，并能够使用此代码从B6:B12和M6:M12中获取第一组数据，然后将其粘贴到我想要的位置的新工作表上。代码如下：

Sub CopyandPaste()

NextFree = Range("B6:B" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
Range("B" & NextFree).Select

NextFree2 = Range("M6:M" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
Range("M" & NextFree2).Select

Sheets("Sheet 1").Range("B6:B" & NextFree).Copy Destination:=Sheets("Sheet 2").Range("B13")

Sheets("Sheet 1").Range("M6:M" & NextFree2).Copy Destination:=Sheets("Sheet 2").Range("J13")

End Sub

---

这是为了在空白之前抓取第一组，这两个空白单元格，但是我找不到一种方法来抓取第二、第三、等等两个空白单元格的组。任何帮助都将不胜感激。

如果您知道块的模式（block-2 spaces-block），您可以进行嵌套循环

Sub grabBlocks()

Dim cFirst As Range, cLast As Range
Dim sh As Worksheet

Set sh = ThisWorkbook.Sheets(1)
Set cFirst = sh.Range("B6") 'First Cell of each new block
Set cLast = cFirst 'This becomes last cell of the block

Do While Not cFirst = ""

    'Get Last Cell of Block
    Do While Not cLast.Offset(1, 0) = ""
        Set cLast = cLast.Offset(1, 0)
    Loop

    'Do copy with this address
    Debug.Print Range(cFirst.Address & ":" & cLast.Address).Address
    '... copy code goes here...

    'Go to next block
    Set cFirst = cLast.Offset(3, 0) 'First cell of new block is 2 + 1 cells below the last
    Set cLast = cFirst
Loop

End Sub

当下一个块超过2个单元格时，此代码将终止，不希望出现更多的块

---

请注意，如果无法满足终止条件（例如，单元格包含“不可见”的数据，如空格），这些循环可能会变得很糟糕。

查找循环和if语句。谢谢！这就是抓取块，但我不知道如何将每个块复制到第2页上它自己的唯一目的地。例如，我希望第一个区块转到B13，第二个区块转到第2页的B28。有什么建议吗？从您的示例判断，目标地址与源地址相同-仅在另一张纸上。为什么不复制整个列而不是抓取块呢？第二张纸上的目标单元格始终是B13、B31、B45和B53。这是由于这些单元格上方的标题造成的。有足够的空间容纳数据集中的任何块，然后将多余的行设置为删除。可以将映射存储在Dictionary对象中，键为增量。在抓取块时，可以增加一个计数器，并在函数的帮助下查找目的地。另一方面，您也可以将映射存储在单独的工作表中。我可以使用第一个循环，然后用四个if语句重复它。非常感谢你的帮助<代码>如果cFirst为“”，则不执行。偏移量（1，0）=“”，设置碎屑=碎屑。偏移量（1，0）循环范围（cFirst.Address&“：”&碎屑。地址）。复制目标：=工作表（“工作表2”）。范围（“B13”）结束，如果设置cFirst=碎屑。偏移量（3，0）设置碎屑=cFirst（对下一个单元格目标重复）

Sub copynPaste()
Dim i As Integer, j As Integer
j = 1
   'loops from 1 to the last filled cell in column 2 or "B"
    For i = 1 To Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
       'checks if the cell has anything in it
        If IsEmpty(Sheets("Sheet1").Range("B" & i)) = False Then
            'this is where the copying and pasting happens (well basically)
            Sheets("Sheet2").Range("B" & j).Value = Sheets("Sheet1").Range("B" & i).Value
            Sheets("Sheet2").Range("M" & j).Value = Sheets("Sheet1").Range("M" & i).Value
            j = j + 1
        End If
    Next i
End Sub