Find&Copy only copying 1 instance of match

Hi guys,

Can someone please tell me how to get my below code to not copy 1 match of the inputed item, rather all of them.

At the moment if i enter 'Sarah' only 1 sarah is found when in reality sarah appears many times, though only 1 row is being copied with it.

Thanks in advance,

Sub findandmake()

Dim ws1 As Worksheet 'Search
Dim SearchRng As Range
Dim ws2 As Worksheet 'Physical
Dim FindRng2 As Range
Dim ws3 As Worksheet 'Virtual
Dim FindRng3 As Range
Dim Ws4 As Worksheet 'Output

Dim CopyRng As Range 'Set when Found
Dim PasteRng As Range 'keeps the latest row

Set ws1 = Worksheets("Servers To Find")
Set SearchRng = ws1.Range("A1:A" & ws1.Cells(ws1.Cells.Rows.Count, 1).End(xlUp).Row)

Set ws2 = Worksheets("Physical Servers")
Set FindRng2 = ws2.Range("P2:P" & ws2.Cells(ws2.Cells.Rows.Count, 4).End(xlUp).Row)

Set Ws4 = Worksheets("Server Results")
Set PasteRng = Ws4.Cells(1, 1)


'Loop through cells removing excess spaces in CRRng of Croff Ref Data WS
With Sheets("Servers To Find")
        
    For Each cl In SearchRng
        If Len(cl) > Len(WorksheetFunction.Trim(cl)) Then
            cl.Value = WorksheetFunction.Trim(cl)
        End If
    Next cl

End With


'Clear all
Ws4.Cells.ClearContents

'First the Headers
ws2.Range("2:2").Copy Destination:=PasteRng
Set PasteRng = PasteRng.Offset(1, 0)

'If Found in Ws1 then copy entire row to Ws4
For Each Ccell In SearchRng
  Set CopyRng = FindRng2.Find(What:=Ccell, LookAt:=xlPart)
  If Not CopyRng Is Nothing Then
    CopyRng.EntireRow.Copy Destination:=PasteRng
    Set PasteRng = PasteRng.Offset(1, 0)
            End If
Next



Call resizeCol2 'this calls the sub that will resize columns in the Server Results WS.
Sheets("Menu").Select
  MsgBox ("Server CI search complete. See 'Server Results' work sheet")
End Sub