[COLOR=blue]Sub[/COLOR] Test4()
Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
[COLOR=blue]Dim[/COLOR] Tablo()
[COLOR=blue]Dim[/COLOR] Tablo2()
Z = 0
y = 0
[COLOR=blue]With[/COLOR] Feuil2
lig = .Cells(Rows.Count, "A").End(xlUp).Row
[COLOR=blue]ReDim[/COLOR] Tablo(0 [COLOR=blue]To[/COLOR] lig, 1 [COLOR=blue]To[/COLOR] 4)
[COLOR=blue]ReDim[/COLOR] Tablo2(y)
[COLOR=blue]For[/COLOR] i = 2 [COLOR=blue]To[/COLOR] lig
[COLOR=blue]If[/COLOR] .Range("A2:A" & lig).Find(Cells(i, 2), LookAt:=xlWhole) [COLOR=blue]Is Nothing Then[/COLOR]
Tablo2(y) = .Cells(i, 2)
y = y + 1
[COLOR=blue]ReDim Preserve[/COLOR] Tablo2(y)
[COLOR=blue]For[/COLOR] k = 2 [COLOR=blue]To[/COLOR] 5
Tablo(Z, k - 1) = .Cells(i, k)
[COLOR=blue]Next[/COLOR] k
Z = Z + 1
[COLOR=blue]End If[/COLOR]
[COLOR=blue]Next[/COLOR] i
[COLOR=blue]If UBound[/COLOR](Tablo2, 1) <> 0 [COLOR=blue]Then[/COLOR] .Range("A" & .Cells(Rows.Count, "A").End(xlUp).Row + 1).Resize([COLOR=blue]UBound[/COLOR](Tablo2, 1)) = Application.Transpose(Tablo2)
Lig2 = .Cells(Rows.Count, "A").End(xlUp).Row
Range("B2:E" & Lig2).ClearContents
[COLOR=blue]With[/COLOR] .Sort
.SetRange Range("A2:A" & Lig2)
.Header = xlNo
.Orientation = xlTopToBottom
.Apply
[COLOR=blue]End With[/COLOR]
[COLOR=blue]If[/COLOR] Lig2 > 500 [COLOR=blue]Then[/COLOR] Rows(2 & " : " & Lig2 - 500).Delete
[COLOR=blue]End With[/COLOR]
[COLOR=blue]With[/COLOR] Feuil1
[COLOR=blue]If[/COLOR] .Range("B2") <> "" [COLOR=blue]Then[/COLOR] .Range("B2:F" & .Cells(Rows.Count, "B").End(xlUp).Row).ClearContents
.Range("B2").Resize([COLOR=blue]UBound[/COLOR](Tablo, 1), 4) = Tablo
.Activate
[COLOR=blue]End With[/COLOR]
Application.ScreenUpdating = [COLOR=blue]True[/COLOR]
[COLOR=blue]End Sub[/COLOR]