VB Code to find duplicate and copy records

Sub J3v16()
Dim Rng As Range, lr As Long
With Sheet1
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set Rng = .Range("F1:F2"): Rng(2).Formula = "=COUNTIF($B$2:$B$" & lr & ", B2)>1"
    With .ListObjects(1)
        .Range.AdvancedFilter 1, Rng
        .DataBodyRange.Copy .Parent.Range("H2")
    End With
    .ShowAllData: Rng.Clear
End With
End Sub