نقل البيانات مع عدم التكرار

[اشرف سعيد السويسي]

ارغب فى معادلة او كود لنقل اسماء العملاء الى ورقة 2 مع عدم التكرار 

5555.xls

[ابراهيم الحداد]

السلام عليكم ورحمة الله

استخدم هذا الكود

Sub UniqData()
Dim ws As Worksheet, sh As Worksheet, C As Range
Set ws = Sheets("1")
Set sh = Sheets("2")
Dim obj As Scripting.dictionary
Set obj = New Scripting.dictionary
For Each C In ws.Range("C3:C" & ws.Range("C" & Rows.Count).End(3).Row)
obj(C & "") = ""
Next
sh.Range("B4").Resize(obj.Count) = Application.Transpose(obj.keys)
End Sub

 

[omar elhosseini]

شاهد المرفق اخي

5555.xls