Tableau et doublon

Sub Unik()
Dim Tblo(), i As Long, Dico As Object
Set Dico = CreateObject("Scripting.Dictionary")
Tblo = Range("A2:L" & Cells(Rows.Count, 3).End(3).Row)
For i = 1 To UBound(Tblo)
  If Dico.exists(Tblo(i, 1)) Then
    Tblo(Dico(Tblo(i, 1)), 2) = Tblo(Dico(Tblo(i, 1)), 2)
  Else
    x = x + 1
    Tblo(x, 1) = Tblo(i, 1)
    Tblo(x, 2) = Tblo(i, 2)
    Tblo(x, 3) = Tblo(i, 3)
    Tblo(x, 4) = Tblo(i, 4)
    Tblo(x, 5) = Tblo(i, 5)
    Tblo(x, 6) = Tblo(i, 6)
    Tblo(x, 7) = Tblo(i, 7)
    Tblo(x, 8) = Tblo(i, 8)
    Tblo(x, 9) = Tblo(i, 9)
    Tblo(x, 10) = Tblo(i, 10)
    Tblo(x, 11) = Tblo(i, 11)
    Tblo(x, 12) = Tblo(i, 12)
    Dico(Tblo(i, 1)) = x
  End If
Next i
[N2].Resize(x, 11) = Tblo
End Sub

Option Explicit

Sub supprime()
Dim i As Long, r As Range, x As Range
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = Worksheets.Count To 2 Step -1
            Sheets(i).UsedRange.Interior.ColorIndex = xlNone
            For Each r In Sheets(i).UsedRange.Columns(1).Cells
                If Not .exists(r.Value) Then
                    .Item(r.Value) = Empty
                Else
                    If x Is Nothing Then
                        Set x = r.EntireRow
                    Else
                        Set x = Union(x, r.EntireRow)
                    End If
                End If
            Next
            .RemoveAll
            'Supprime les lignes en double
            'If Not x Is Nothing Then x.Delete
            'Surligne les ligne en double
            If Not x Is Nothing Then x.Interior.ColorIndex = 43
            Set x = Nothing
        Next
    End With
End Sub