Copy rows between two values VBA and paste to new sheet loop - excel

Question

I am trying to figure out some code here, I have looked on a few sites now, including here and it almost works but it is most likely my datasheet that is causing the issue.
This: Search for two values and copy everything in between in a loop
and this: I need code to copy between two rows and paste into the another sheet with our giving any values?
Would probably work, however the first value cannot be found. Let me explain.
I have an exported report from a website, it groups the totals with a name (value 1) and then the word totals for: (word 2).
What I need it to do is only copy and paste where value 1 is met , and value 2 will always be "totals for:".
Problem is with this loop is that there are blanks between each group of data, so it finds the first "totals for:" but cannot find my first value because it is between about 20 blank cells. (19 groups of data - with a blank row between each group).
How can i retro fix the above codes so that it keeps going down the rows, regardless of blanks to find the first value, then find the second value. Copy that range to a new sheet, and repeat this with a new value 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
I attached the codes that almost work, but cannot find my first value.

Answer 1

You can use Find method which looks something like:
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
You can then have this in a loop which replaces the strings you want found. HTH.