XL 2016 Supprimer enregistrement identique

Sub Test()
Dim T1 As String, T2 As String, P1 As String, P2 As String
With ThisWorkbook.Sheets("Feuil1")
P1 = "SELECT * from [Feuil1$" & Replace(.Range(.Range("A1"), .Cells(.Cells.Rows.Count, "E").End(xlUp)).Address, "$", "") & "]"
P2 = "SELECT * FROM [Feuil1$" & Replace(.Range(.Range("G1"), .Cells(.Cells.Rows.Count, "K").End(xlUp)).Address, "$", "") & "]"
Dim SQL1 As String, SQL2 As String
SQL1 = P1 & " as  FRM1 left join (" & P2 & ") as FRM2 on FRM2.CODE=FRM1.CODE and FRM2.Statut=FRM1.Statut and FRM2.Age=FRM1.Age and FRM2.sexe=FRM1.sexe and FRM2.ttt=FRM1.ttt"
SQL1 = SQL1 & " WHERE FRM2.CODE is null"

SQL2 = P2 & " as  FRM1 left join (" & P1 & ") as FRM2 on FRM2.CODE=FRM1.CODE and FRM2.Statut=FRM1.Statut and FRM2.Age=FRM1.Age and FRM2.sexe=FRM1.sexe and FRM2.ttt=FRM1.ttt"
SQL2 = SQL2 & " WHERE FRM2.CODE is null"
End With
With CreateObject("AdoDb.Connection")
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    With .Execute(SQL1)
        T1 = .GetString(, , vbTab, vbCrLf, "")
        .Close
    End With
    With .Execute(SQL2)
        T2 = .GetString(, , vbTab, vbCrLf, "")
        .Close
    End With
    
 
    .Close
  
End With
With Sheets("Feuil1")
    With .UsedRange
        Range(.Range("A2"), .Cells(.Rows.Count, .Columns.Count)).Clear
    End With
    PressePapier = T1: .Range("A2").PasteSpecial xlPasteAll
    PressePapier = T2: .Range("G2").PasteSpecial xlPasteAll
    ClearCipboard
End With

End Sub

Public Property Let PressePapier(Value)
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .SetText Value
    .PutInClipboard
 End With
End Property
 
Public Property Get PressePapier()
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .GetFromClipboard
    PressePapier = .GetText
End With
End Property
Function ClearCipboard()
'Early binding will requires a Reference to 'Microsoft Forms 2.0 Object Library'
    Dim oData  As Object    'New MSForms.DataObject

    Set oData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    oData.SetText Text:=Empty
    oData.PutInClipboard
    Set oData = Nothing
End Function

Sub test_pj5()
Feuil2.[A:K].Copy [A1] 'initialisation
t = Timer
derlin1 = Range("A" & Rows.Count).End(xlUp).Row
derlin2 = Range("G" & Rows.Count).End(xlUp).Row
'associer le chiffre 1 au tableau1 en colonne F et le chiffre 2 au tableau2
Range("F2:F" & derlin1) = 1
Range("L2:L" & derlin2) = 2
'copier le tableau2 a la suite du tableau1
Range("$G$2:$L$" & derlin2).Copy Destination:=Range("A" & derlin1 + 1)
derlin3 = Range("A" & Rows.Count).End(xlUp).Row
'supprimer les doublons
Range("$A$2:$F$" & derlin3).RemoveDuplicates Columns:=Array(1, 3, 4)
'recuperer la 1ere ligne ayant le chiffre 2 en colonne F (ici commence le tableau2 sans doublon
Set c = Columns("F").Find(2)
'reporter le tableau2 a sa place initiale
Range("A" & c.Row & ":F" & derlin3).Copy Destination:=Range("G2")
'supprimer le tableau2 en fin de tableau1
Range("A" & c.Row & ":F" & derlin3).Delete shift:=xlUp
'effacer les colonnes de reperage
Columns("F").ClearContents
Columns("L").ClearContents
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub