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

我有一个电子表格，其中将有多个标题样式行。我想使用脚本复制每个标题下的行。我现在有一个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

除了复制标题本身（

此处

），而不复制标题下的数据外，这是可行的。我还是VBA新手，所以我不知道如何调整它。我尝试过像

Dim j As Integer

，然后

j=I+1

和

j.EntireRow

等，但这不起作用，因为

I

是

范围

而不是

整数

。我对VBA的了解还不够，无法让它正常工作

有什么建议吗？谢谢大家!

---

编辑：除了仅复制标题下的第一行时的场景外，我是否可以将其修改为复制标题下的

x

行？例如，找到标题后，复制下三行。再次感谢

根据我的理解，我修改如下

Private Sub CommandButton4_Click()
    Dim i As Long
    lastcolumn = Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 1 To lastcolumn
        If Cells(1, i) = "HERE" Then
            Range(Cells(2, i), Cells(4, i)).Copy Sheet3.Range("A" & Sheet3.Range("A" & Rows.Count).End(xlUp).Row + 1) ' Here i have copied 2nd row to 4th row. Modify this as per your wish
        End If
    Next i
End Sub

---

第1页：

第三张：

编辑1

如果要将行复制到列中的另一行，请替换下面的代码。它会起作用的

Private Sub CommandButton4_Click()
    Dim i As Long
    lastcolumn = Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 1 To lastcolumn
        If Cells(1, i) = "HERE" Then
            'lastrow = Columns(i).SpecialCells(xlLastCell).Row
            lastrow = Columns(i).Find("HERE").Row
            Range(Cells(2, i), Cells(lastrow, i)).Copy Sheet3.Range("A" & Sheet3.Range("A" & Rows.Count).End(xlUp).Row + 1)
        End If
    Next i
End Sub

将属性与范围

i

一起使用，以获取

i

下一行：

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

编辑：您可以使用此选项复制所有行，直到遇到下一个“此处”：

第3张：

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

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

Edit2:它复制单词“here”（不区分大小写，注意使用

UCase

）下面的所有行：

表1：

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

HERE |      |    
22   |  22  |  22

 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

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

---

你能显示你的标题吗？以及要复制到第3页的数据？这样就很容易understand@NanAvanIllai我相信标题中的第一个单元格将始终是“项目编号”。这将是我的指示，下一行将是我想要复制的。也请看我的编辑。这看起来不错，谢谢。您知道如何修改它，然后复制“HERE”下的所有行，直到它到达另一个“HERE”？此时，它将通过更改此

范围（单元格（2，i），单元格（4，i））.Copy

如果要将第二行复制到1000，则它将是

范围（单元格（2，i），单元格（1001，i））.Copy

。希望对你有帮助很好，我会尽快测试并让你知道。我不知道偏移量可以用这种方式进行编辑，但有一个小问题除外：

ElseIf

将复制工作簿中a列中具有非空值的其他行。我只希望

ElseIf

复制a列中具有非空值的行，如果它们位于具有“HERE”的行的正下方在A栏，有什么想法吗？非常感谢。这可能是一本理解Edit2的好读物。我希望它能满足您的要求。请注意Edit2中的一个重要编辑：

I>=lastRow