Excel VBA - 循环复制特定值下方的行

Question

我有一个电子表格，其中包含多个标题样式行。我想使用脚本复制每个标题下方的行。我目前从一个 3 年前的 StackOverflow 答案中得到了这个:

Private Sub CommandButton4_Click()

    Dim i As Range

    For Each i In Sheet1.Range("A1:A1000")
        Select Case i.Value
            Case "HERE"
                Sheet3.Range("A" & Sheet3.Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Value = i.EntireRow.Value
            Case Else

        End Select
     Next i

End Sub

这有效，只是它复制 header 本身(此处)，而不是其下面的数据。我对VBA还是个新手，所以我不知道如何调整它。我尝试过类似 Dim j As Integer，然后 j = i + 1 和 j.EntireRow 等，但这不起作用因为 i 是 Range 而不是 Integer。我对 VBA 的了解还不够，无法实现此功能。

有什么建议吗？谢谢!

编辑:除了仅复制标题下方第一行的情况之外，我还可以修改此设置以复制标题下方的 x 行吗？例如，一旦找到标题，就复制接下来的三行。再次感谢!

Answer 1

使用Offset(1, 0)属性与 Range i 获取下一行 i:

Sheet3.Range("A" & Sheet3.Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Value = i.Offset(1, 0).EntireRow.Value

编辑:您可以使用它复制所有行，直到遇到下一个“HERE”:

Private Sub CommandButton4_Click()

    Dim i As Range

    For Each i In Sheet1.Range("A1:A5")

        If i.Value = "HERE" Then
            Sheet3.Range("A" & Sheet3.Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Value = i.Offset(1, 0).EntireRow.Value
        ElseIf i.Value <> "" Then
            Sheet3.Range("A" & Sheet3.Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Value = i.EntireRow.Value
        Else
            'Else is optional, feel free to remove if not required
        End If

     Next i

End Sub

表1:

 A   |   B  |  C
HERE |      |   
11   |  11  |  11
33   |  33  |  33

HERE |      |    
22   |  22  |  22

表3:

 A   |   B  |  C
11   |  11  |  11
33   |  33  |  33 
22   |  22  |  22

Edit2:它复制“here”一词紧下方的所有行(不区分大小写，请注意使用 UCase):

Private Sub CommandButton4_Click()

    Dim i As Long
    Dim j As Long
    Dim lastRow As Long
    Dim blankRow As Long

    i = 1
    lastRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
    blankRow = Sheet3.Range("A" & Sheet3.Rows.Count).End(xlUp).Row + 1

    Do While True

        If UCase(Sheet1.Range("A" & i).Value) = "HERE" Then

            j = Sheet1.Range("A" & i).End(xlDown).Row

            Union(Sheet1.Range("A" & i + 1).EntireRow, Sheet1.Range("A" & j).EntireRow).Copy
            Sheet3.Range("A" & blankRow).PasteSpecial xlValue

            blankRow = Sheet3.Range("A1").End(xlDown).Row + 1
            i = j + 1

        Else
            i = i + 1
        End If

        If i >= lastRow Then
            Exit Do
        End If

    Loop

End Sub

表1:

 A   |   B  |  C
HERE |      |   
11   |  11  |  11
33   |  33  |  33

55   |  55  |  55

HERE |      |    
22   |  22  |  22

44   |  44  |  44    

表3:

 A   |   B  |  C
11   |  11  |  11
33   |  33  |  33 
22   |  22  |  22