Hi, Jon,

maybe take the code from How to select, copy and paste rows from a find operation and modify ot a little bit to
Sub EF923452()
'adapted from EF918610, 27. April 2013
Dim lngNextRow As Long
Dim strMyString As String
Dim strAddress As String
Dim rngFound As Range
Dim blnLoop As Boolean

strMyString = "Voice"
With Sheets("Sheet2")
  lngNextRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
End With

With Sheets("Sheet1")
  Set rngFound = .Cells.Find(What:=strMyString, after:=.Cells(Rows.Count, "A"), LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
  If Not rngFound Is Nothing Then
    strAddress = rngFound.Address
    blnLoop = True
    Sheets("Sheet2").Cells(lngNextRow, "A").Resize(5, 1).Value = rngFound.Offset(1, 0).Resize(5, 1).Value
    lngNextRow = lngNextRow + 5
    Do While blnLoop
      Set rngFound = .Cells.FindNext(after:=rngFound)
      If rngFound.Address <> strAddress Then
        Sheets("Sheet2").Cells(lngNextRow, "A").Resize(5, 1).Value = rngFound.Offset(1, 0).Resize(5, 1).Value
        lngNextRow = lngNextRow + 5
      Else
        blnLoop = False
      End If
    Loop
  Else
    MsgBox "Could not find " & strMyString & " anywhere on this sheet.", , "Unsuccessful search"
  End If
End With
End Sub
Ciao,
Holger