Sub Transfert()
Dim cel As Range, ref As Range
Application.ScreenUpdating = False
ActiveSheet.AutoFilterMode = False
Sheets("efg").Range("6:65536").Clear
On Error Resume Next
For Each cel In Range("A5:A" & Range("A65536").End(xlUp).Row)
If Application.CountIf(Range("A5:A" & cel.Row), cel) = 1 Then
Set ref = Sheets("efg").Range("B65536").End(xlUp)(2)
cel.Copy ref.Offset(0, -1)
Range("A4:C65536").AutoFilter Field:=1, Criteria1:=cel
Range("C5:C" & Range("C65536").End(xlUp).Row).SpecialCells(xlVisible).Copy ref
Range("A4:C65536").AutoFilter
End If
Next
Application.ScreenUpdating = True
End Sub