copy duplicate rows to new sheet in WB
 

I'm trying to get this code to identify duplicate numbers in WS "All Records"
in column B and copy the entire row for any duplicates found to a new sheet
in the workbook called "Duplicates". I appreciate your help, thank you.

Dim rng As Range, cell As Range

Dim i As Long, sh As Worksheet
With Worksheets("All Records")
Set rng = .Range(.Cells(1, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End With
i = 1

Set sh = Worksheets("Duplicates")
For Each cell In rng
If UCase(Trim(cell.Value)) = "4-$" Or _
UCase(Trim(cell.Value)) = "CNO-$" Then
If UCase(Trim(cell.Offset(0, 1).Value)) = _
"GESA CC" Then
cell.EntireRow.Copy sh.Cells(i, 1)
i = i + 1

End If

End If

Next

End Sub