أبحث عن كود يقوم بنقل قيم عمود لمكان أخر ولكن بدون تكرار للقيم

[أبو العاصم]

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

الكود كان معى ولكن الفلاش ميمورى تلفت

وحاولت البحث عنه فلم أهتد إليه

الرجاء المساعدة

باك الله فيكم

[عبد الفتاح كيرة]

أهو هذا

Sub ÒÑ1_ÇäÞÑ()

On Error Resume Next

Dim mycol As Collection

Dim myrng As Range

Set mycol = New Collection

For Each myrng In Range("a1:a300")

mycol.Add myrng.Value, myrng.Value

Next myrng

For i = 1 To mycol.Count

Range("b" & i) = mycol(i)

Next i

End Sub

المرفق

حذف السطور المكررة باستخدام collection-kemas.rar

تم تعديل يونيو 12, 2011 بواسطه kemas

[أبو العاصم]

أخى العزيز كيماس بارك الله فيك الملف هو المطلوب ولكن بارك الله فيك لى عليه طلبان مهمان شرحهما بالمرفق وجزاك الله خيرا

طلب أخر.rar

[عبد الفتاح كيرة]

أبو عاصم

تم تنفيذ طلبك الأول و الثانى

الطلب الثالث

الله يعين

Sub ZEKO()

On Error Resume Next

Dim mycol As Collection

Dim myrng As Range

Set mycol = New Collection

For Each myrng In Range("a1:a300")

mycol.Add myrng.Value, myrng.Value

Next myrng

Sheets("المكرر").Range("a:b").ClearContents

For i = 1 To mycol.Count


Sheets("المكرر").Range("a" & i) = mycol(i)

Next i

End Sub

حذف السطور المكررة باستخدام collection-kemas2.rar

[أبو العاصم]

جزاك الله خيرا بس لى طلب أخر

لو أنا عاوز النسخ فى الورقة الثانية يكون بدايته من الخلية C7 وينسخ فى العامود C كيف أعدله فى الكود

بمعنى أخر تعديل الكود ليلصق البيانات المصفاة الى أى نطاق تطلبه مع مسح النطاق قبل التصفية فقط وليس عامودين

[yhiacom]

الف شكر اخي العزيز

[عبد الفتاح كيرة]

نعم أخى

هذا هو سطر اللصق و فيه المدى

Sheets("ÇáãßÑÑ").Range("a" & i) = mycol(i)

و لتغيير المدى ل c7 يصير

Sheets("ÇáãßÑÑ").Range("c" & i + 6) = mycol(i)

المرفقات

الأخ الأستاذ yhiacom

أشكرك على مرورك الكريم

حذف السطور المكررة باستخدام collection-kemas3.rar

[أبو العاصم]

والله أخى العزيز كيماس بارك الله فيك

[أبو العاصم]

لنا طلب أخر هو نسخ الشواذ أو الأرقام التى لم تتكرر فى البيانات

الى نطاق أخر بصفحة أخرى بداية من خلية محددة