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 

这是有效的，除了它复制标题本身（ HERE ），而不是它下面的数据。 我还是新来的VBA，所以我不知道如何调整这一点。 我已经尝试过像Dim j As Integer ，然后j = i + 1和j.EntireRow等，但是这是行不通的，因为i是Range而不是Integer 。 我对VBA了解不多，但还没有完成。

有什么build议？ 谢谢！

编辑：除了复制头只下面的第一行的情况下，我也可以修改此复制x行下的标题？ 例如，一旦find标题，请复制下三行。 再次感谢！

Answer 1

使用范围i Offset(1, 0)属性来获得下一行的i ：

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

编辑：您可以使用它来复制所有行，直到您遇到下一个“这里”：

 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 

工作表Sheet1：

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

表Sheet 3：

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

编辑2：它复制紧接着单词“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 

工作表Sheet1：

  A | B | C HERE | | 11 | 11 | 11 33 | 33 | 33 55 | 55 | 55 HERE | | 22 | 22 | 22 44 | 44 | 44 

表Sheet 3：

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

Answer 2

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

 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 

---

Sheet1：

Sheet3：

编辑1

如果您想复制行中的另一个列，则replace下面的代码。 它会工作。

 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