代码示例：

Sub CopyDuplicates()

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim rng1 As Range, rng2 As Range, cel As Range, rngToCopy As Range
Dim i As Long, j As Long, k As Long

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets.Add

With ws1
    Set rng1 = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
    Set rng2 = .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
End With

With ws2
    For Each cel In rng1
        j = Application.Match(cel.Value, rng2, 0)
        If Not IsError(j) Then
            If rngToCopy Is Nothing Then
                Set rngToCopy = cel
            Else
                Set rngToCopy = Union(rngToCopy, cel)
            End If
        End If
    Next cel
End With

If rngToCopy Is Nothing Then
    MsgBox "No duplicates found.", vbInformation, "Duplicate Checker"
    Exit Sub
End If

rngToCopy.Copy ws3.Range("A1")
k = rngToCopy.Cells.Count
MsgBox k & " duplicate row(s) found and copied to Worksheet3.", vbInformation, "Duplicate Checker"

End Sub