Copy paste data based on criteria

[littleiitin]

Try This:

Sub FindandDelete()
    
    Dim rngMakeRange        As Range
    Dim lngCnt              As Long
    Dim rngFindNext         As Range
    Dim rngCheck            As Range
    Dim dicRow              As Object
    
    Set dicRow = CreateObject("Scripting.Dictionary")
    With Sheet1
        Set rngFindNext = .Range("A:O").Find(.Range("O2").Value)
        Set rngMakeRange = rngFindNext
        dicRow.Add rngFindNext.Row, 1
        Do Until Not Intersect(rngMakeRange, .Range("A:O").FindNext(rngFindNext)) Is Nothing
            Set rngFindNext = .Range("A:O").FindNext(rngFindNext)
            If Not dicRow.Exists(rngFindNext.Row) Then
                dicRow.Add rngFindNext.Row, 1
                If rngMakeRange Is Nothing Then
                    Set rngMakeRange = rngFindNext
                Else
                    Set rngMakeRange = Union(rngMakeRange, rngFindNext)
                End If
            End If
        Loop
    End With
    rngMakeRange.EntireRow.Delete
    
End Sub