Sub Macro1()
Dim DerLigne As Long
Sheets("Base").Copy after:=Sheets(Sheets.Count)
DerLigne = ActiveSheet.Range("F1").End(xlDown).Row
Range("J1") = "SupprD"
With Range("J2:J" & DerLigne)
.FormulaR1C1 = "=RC[-4]&RC[-2]"
.Value = .Value
End With
Columns("J:J").RemoveDuplicates Columns:=1, Header:=xlYes
Range(Cells(2, "J"), Cells(Rows.Count, "J").End(xlUp)).Copy Sheets("Resultat").Range("A3")
Application.DisplayAlerts = False
Sheets(Sheets.Count).Delete
End Sub