Identifier cellule en doublon

Sub ListeDoublons()
  Set mondico1 = CreateObject("Scripting.Dictionary")
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In [A1:C10]
    temp = c.Value
    If Not mondico1.exists(temp) Then
      mondico1.Add temp, temp
    Else
      mondico2.Add c.Address, temp
      c.Interior.ColorIndex = 4
    End If
  Next c
  [h2].Resize(mondico2.Count, 1) = Application.Transpose(mondico2.keys)
  [i2].Resize(mondico2.Count, 1) = Application.Transpose(mondico2.items)
End Sub

Sub essai()
Dim tab_doublon
Set tab_doublon = CreateObject("Scripting.Dictionary")
For Each cellule In Range(Cells(1, 1), Cells(10, 3))
    tmp2 = Replace(cellule.Address, "$", "")
    If InStr(ya, cellule) > 0 Then tab_doublon(tmp2) = cellule
    ya = ya & cellule
Next
l = 2: c = 7
Cells(l, c).Select
Cells(l, c).Resize(100, 2).ClearContents
Cells(l, c + 1).Resize(tab_doublon.Count, 1) = Application.Transpose(tab_doublon.Items)
Cells(l, c).Resize(tab_doublon.Count, 1) = Application.Transpose(tab_doublon.keys)
Cells(l, c).Resize(tab_doublon.Count, 2).Select
Selection.Sort Key1:=Cells(l, c), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Cells(l, c).Select
End Sub