match copy and delet

Halo~
Try this

Sub CopyRows()
Dim rng As Range
For I = 2 To Sheets("name").Cells(Rows.Count, "A").End(xlUp).Row

Set vfound = Sheets("Data Set").Columns("F:I").Cells.Find(What:=Sheets("name").Range("A" & I).Value, _
MatchCase:=False)

If Not vfound Is Nothing Then
vStart = vfound.Address
vMatch = True

Do
Sheets("Data Set").Range("A" & vfound.Row & ":" & "I" & vfound.Row).Copy Destination:= _
Sheets("Output Sheet").Range("A" & Sheets("Output Sheet").Cells(Rows.Count, "A").End(xlUp).Row + 1 _
& ":" & "I" & Sheets("Output Sheet").Cells(Rows.Count, "A").End(xlUp).Row + 1)
If rng Is Nothing Then
    Set rng = vfound
Else
    Set rng = Union(rng, vfound)
End If
Set vfound = Sheets("Data Set").Columns("f:i").Cells.FindNext(vfound)
Loop Until vfound.Address = vStart
End If
rng.EntireRow.Delete
Set rng = Nothing
Next I

If vMatch <> True Then
MsgBox ("NO MATCHES FOUND")
End If

End Sub