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

Question

我在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

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

Answer 1

如果您知道块的模式(块-2空格块)，则可以执行嵌套循环。

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

当下一个块超过两个单元时，此代码将终止，预计不会有更多的块出现。

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

Answer 2

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