Sub test()
Dim F1, F2 As Worksheet
Dim TF1, TF2 As Variant
    Set F1 = Worksheets("Feuil1")
        TF1 = F1.Range(F1.Cells(2, 1), F1.Cells(F1.Cells(65536, 4).End(xlUp).Row, 4))
    Set F2 = Worksheets("Feuil2")
        TF2 = F2.Range(F2.Cells(2, 1), F2.Cells(F2.Cells(65536, 4).End(xlUp).Row, 4))
'''''''''''
Dim Tid() As Variant
Dim cpt As Double
    ReDim Preserve Tid(LBound(TF1, 1) To UBound(TF1, 1) + UBound(TF2, 1), LBound(TF1, 2) To UBound(TF1, 2))
    For i = LBound(Tid, 1) To UBound(Tid, 1)
        For j = LBound(Tid, 2) To UBound(Tid, 2)
            If i <= UBound(TF1, 1) Then
                Tid(i, j) = TF1(i, j)
                cpt = i
            Else
                Tid(i, j) = TF2(i - cpt, j)
            End If
        Next j
    Next i
    cpt = 1
'''''''''''
    For i = LBound(Tid, 1) To UBound(Tid, 1)
        For j = i + 1 To UBound(Tid, 1)
            If Tid(i, 2) & Tid(i, 3) & Tid(i, 4) = Tid(j, 2) & Tid(j, 3) & Tid(j, 4) Then
                Tid(j, 1) = "D"
            End If
        Next j
    Next i
'''''''''''
    For i = LBound(Tid, 1) To UBound(Tid, 1)
        If Tid(i, 1) = "" Then
            Tid(i, 1) = "ID" & cpt
            cpt = cpt + 1
        End If
    Next i
    cpt = Empty
'''''''''''
    For i = LBound(Tid, 1) To UBound(Tid, 1)
        If Tid(i, 1) <> "D" Then
            If i <= UBound(TF1, 1) Then
                TF1(i, 1) = Tid(i, 1)
                cpt = i
            Else
                TF2(i - cpt, 1) = Tid(i, 1)
            End If
        Else
            If i <= UBound(TF1, 1) Then
                For j = LBound(Tid, 1) To UBound(Tid, 1)
                    If Tid(j, 1) <> "D" Then
                        If Tid(j, 2) & Tid(j, 3) & Tid(j, 4) = TF1(i, 2) & TF1(i, 3) & TF1(i, 4) Then
                            TF1(i, 1) = Tid(j, 1)
                        End If
                    End If
                Next j
                cpt = i
            Else
                For j = LBound(Tid, 1) To UBound(Tid, 1)
                    If Tid(j, 1) <> "D" Then
                        If Tid(j, 2) & Tid(j, 3) & Tid(j, 4) = TF2(i - cpt, 2) & TF2(i - cpt, 3) & TF2(i - cpt, 4) Then
                            TF2(i - cpt, 1) = Tid(j, 1)
                        End If
                    End If
                Next j
            End If
        End If
    Next i
    cpt = Empty
'''''''''''
F1.Range("A2").Resize(UBound(TF1, 1), 1).Value = Application.Index(TF1, , 1)
F2.Range("A2").Resize(UBound(TF2, 1), 1).Value = Application.Index(TF2, , 1)
'''''''''''
End Sub