استخراج القيم المكررة فقط

=IFERROR(INDEX($A$2:$A$11,SMALL(IF(FREQUENCY(IF($A$2:$A$11<>"",MATCH($A$2:$A$11,$A$2:$A$11,0),""),MATCH($A$2:$A$11&"",$A$2:$A$11&"",0))>1,ROW($A$2:$A$11)-ROW($A$2)+1,""),ROWS($C$2:C2))),"")

Function AlsaqrDuplicate(rng As Range, rw As Long)

'Programming by Eslam Abdullah

Dim Content As New Collection, i&

On Error Resume Next

     For i = 1 To rng.Find("*", , , , , 2).Row

        If rng.Cells(i).Value <> "" And Application.CountIf(rng, rng.Cells(i)) > 1 Then _

           Content.Add rng.Cells(i), CStr(rng.Cells(i))

        If Content.Count = rw Then AlsaqrDuplicate = Content.Item(rw): Exit Function

     Next i

     AlsaqrDuplicate = ""

End Function

Sub Duplicate()

'Programming by Eslam Abdullah

Dim dic As Object, lr&, i&

Cells(2, 4).Resize(Rows.Count - 1).ClearContents

    Set dic = CreateObject("Scripting.Dictionary"): dic.CompareMode = 1

    lr = Cells(Rows.Count, 1).End(3).Row

        For i = 2 To lr

            If Not dic.Exists(Cells(i, 1).Value) And Cells(i, 1).Value <> "" And Application.CountIf(Range("A2:A" & lr), Cells(i, 1)) > 1 Then _

            dic(Cells(i, 1).Value) = Cells(i, 1).Value

        Next i

    Cells(2, 4).Resize(dic.Count).Value = Application.Transpose(dic.Items)

End Sub