在两个值 VBA 之间复制行并粘贴到新的工作表循环

Question

我正在尝试在这里找出一些代码，我现在查看了一些网站，包括这里，它几乎可以工作，但很可能是我的数据表导致了问题。 这个：Search for two values and copy everything in between in a loop 还有这个：I need code to copy between two rows and paste into the another sheet with our giving any values?

可能会起作用，但是找不到第一个值。让我解释一下。

我有一个从网站导出的报告，它使用名称（值 1）将总计分组，然后将单词总计为：（单词 2）。

我需要它做的只是在满足值 1 的地方复制和粘贴，而值 2 将始终是“总计：”。 这个循环的问题是每组数据之间都有空白，所以它找到了第一个“总计：”但找不到我的第一个值，因为它在大约 20 个空白单元格之间。 （19 组数据 - 每组之间有一个空白行）。

我怎样才能修复上面的代码，以便它继续向下行，不管空格找到第一个值，然后找到第二个值。将该范围复制到新工作表，并使用新值 1 重复此操作？

Sub MoveRows()
Dim rownum As Integer
Dim colnum As Integer
Dim startrow As Integer
Dim endrow As Integer

rownum = 1
colnum = 1

 With ActiveWorkbook.Worksheets("Sheet1")
    Do
       If .Cells(rownum, 1).Value = "LIFEC - Supp Life - Ch" Then
          startrow = rownum
       End If
       rownum = rownum + 1
    Loop Until .Cells(rownum, 1).Value = "Totals for:"
    endrow = rownum
    ActiveWorkbook.Worksheets("Sheet1").Range(startrow & ":" & endrow).Copy

 End With
 ActiveWorkbook.Worksheets("Sheet2").Paste




End Sub


Sub Star123()
Dim rownum As Long
Dim colnum As Long
Dim startrow As Long
Dim endrow As Long
Dim lastrow As Long
rownum = 1
colnum = 1
lastrow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
With ActiveWorkbook.Worksheets("Sheet1").Range("A1:A" & lastrow)


For rownum = 1 To lastrow
 Do
    If .Cells(rownum, 1).Value = "LIFEC - Supp Life - Ch" Then
       startrow = rownum
    End If

    rownum = rownum + 1


 If (rownum > lastrow) Then Exit For

 Loop Until .Cells(rownum, 1).Value = "Totals for:"
 endrow = rownum
 rownum = rownum + 1

 Worksheets("Sheet1").Range(startrow & ":" & endrow).Copy


 Sheets("Sheet2").Select
 Range("A1").Select
 ActiveSheet.Paste


 Next rownum
 End With
 End Sub

我附上了几乎可以工作的代码，但找不到我的第一个值。

Answer 1

你可以使用Find 方法，看起来像：

Dim s As Range, e As Range
With Sheet1 'or this can be any other sheet where you search
    Set r = .Range("A:A").Find("Whatever you want found")
    If Not r Is Nothing Then
        Set e = .Range("A:A").Find("The other end", r)
        If Not e Is Nothing Then
            .Range(r, e).EntireRow.Copy Sheet2.Range("A1") 'or to whatever sheet
        End If
    End If
End With

然后你可以在一个循环中使用它来替换你想要找到的字符串。 HTH。