أخي العزيز / samycalls
هذا التعديل في الكود ليفي بالغرض إن شاء الله
Sub Macro3()[/b]
[b]Application.Calculation = xlManual
Application.ScreenUpdating = False
Range("b2:b1000").ClearContents
Sheets("ورقة1").Range("B1:B786").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("ورقة1").Range("B1:B786"), CopyToRange:=Range("E4"), _
Unique:=True
Range("E4:E786").Sort Key1:=Range("E4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("E4").Select
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
وهذا الملف بعد التعديل
نقل بدون تكرار مع الترتيب3.rar