Try this:
Option Explicit
Sub CopyCALLs()
Dim vFIND As Range, vFIRST As Range, NR As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("Attendance Tracking")
Set ws2 = Sheets("Sheet2")
On Error Resume Next
If MsgBox("Clear prior data on the report?", vbYesNo) = vbYes Then
ws2.UsedRange.Clear
NR = 1
Else
NR = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
End If
With ws1
Set vFIND = .Range("H:H").Find("CALL", LookIn:=xlValues, LookAt:=xlWhole)
If Not vFIND Is Nothing Then
Set vFIRST = vFIND
Do
vFIND.Resize(4).EntireRow.Copy ws2.Range("A" & NR)
NR = NR + 4
Set vFIND = .Range("H:H").FindNext(vFIND)
Loop Until vFIND.Address = vFIRST.Address
ws2.Rows.AutoFit
End If
End With
End Sub
Bookmarks