I’m trying to copy selected rows from sheet Official List to paste in
sheet Contact Report. A Userform asks user to give a value. This value
is assigned name of FindContact in the UserForm. This value will be
located multiple times in a column of Official List. I’ve named this
column ContactRange.
The problem I’m having is finding and selecting each of these rows
that contain the variable. I want this to select each row containing
the FindContact value, then copy it to the sheet named Contact Report.
I’ve been fumbling around, trying to get the Do Until, For Each syntax
correct as you can see below. I’m sure I’m messing up something
simple. Maybe I’m using the wrong approach, so any help would be
appreciated.
Thanks, jeff.

Sub SelectContacts()

Dim FindContact As String

Worksheets("Official List").Activate ‘source sheet
Application.Goto Reference:="ContactOfficialList" ‘this is name given
to column header
ActiveCell.Offset(1, 0).Range("A1").Select ‘goes down to 1st row of
list

‘to loop through the list until empty cell is found, which will be the
end of the list.
Do Until IsEmpty(ActiveCell.Value)

For Each cell In Range("ContactRange")
If cell.Value = FindContact Then
Rows(ActiveCell.Row).Select
Selection.Copy

'Goes to Contact Report folder to paste record in next empty row.
Worksheets("Contact Report").Activate
Range("B65536").End(xlUp).Offset(1, -1).Select
ActiveSheet.Paste

End If
Exit For
ActiveCell.Offset(1, 0).Select ‘moves down to check the next row.

‘After the errors, I tried to change all this around, trying to
stumble on the correct syntax.
Loop
‘Next
'Exit Do

End Sub