إستخراج الاسماء المكررة اعتمادا على رقم الهوية وترحيل المكرر بشيت منفصل

[أبو عبد الرحمن سعيد]

بسم الله الرحمن الرحيم

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

وكل عام انتم  جميعا بخير ورمضان كريم

المطلوب بحول الله تعالى من فضل حضراتكم

تنفيذ الكود المبين بالمرفق التالى من خلال شيت رقم 2

ليتم ترحيل الاسماء المكررة بشيت رقم 5

المشكلة مع تنفيذ الكود يتم حذف محتوى شيت 2 بالكامل

مع وجود السطر التالى 

Range("A8").Resize(Cells(Rows.Count, "A").End(xlUp).Row).EntireRow.Delete

بارك الله فيكم وجزاكم الله خيرا

إستخراج الاسماء المكررة اعتمادا على رقم الهوية وترحيل المكرر بشيت منفصل.rar

تم تعديل يونيو 23, 2016 بواسطه ابو عبدالرحمن بيرم

[ابو عبدالبارى]

56 دقائق مضت, ابو عبدالرحمن بيرم said:

بسم الله الرحمن الرحيم

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

وكل عام انتم  جميعا بخير ورمضان كريم

المطلوب بحول الله تعالى من فضل حضراتكم

تنفيذ الكود المبين بالمرفق التالى من خلال شيت رقم 2

ليتم ترحيل الاسماء المكررة بشيت رقم 5

المشكلة مع تنفيذ الكود يتم حذف محتوى شيت 2 بالكامل

مع وجود السطر التالى 

Range("A8").Resize(Cells(Rows.Count, "A").End(xlUp).Row).EntireRow.Delete

بارك الله فيكم وجزاكم الله خيرا

إستخراج الاسماء المكررة اعتمادا على رقم الهوية وترحيل المكرر بشيت منفصل.rar

اخى الكريم ابو عبدالرحمن بيرم

ارجو ان يفى الملف التالى بالمطلوب

abo_abary_إستخراج الاسماء المكررة اعتمادا على رقم الهوية وترحيل المكرر بشيت منفصل.rar

[أبو حنــــين]

السلام عليكم اخي الحبيب ابو عبد الرحمان

عندما لاحظت صورة البروفيل الخاصة بك ( العين البني ) ، و الصورة الخاصة بي ( خديجة ) و كأنني اقول بلسان الحال : قاعد يبص فيا و انا حاطط إيدي على خدي فجات ببالي الاغنية ألي بتقول :

بتنهد وايدي على خدي من قلب ربّاني وطلع قدي
لا انا فهمان شو بده ولا حضرته فهمان شو بدي

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

اسعد الله ايامك و تقبل الله منا و منكم صالح الاعمال ، و الله ليك وحشة

Sub officena()

Dim Last As Long, R As Long, LR As Long
Last = Sheet4.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheet4
    For R = 5 To Last
        If WorksheetFunction.CountIf(.Range("A8:A" & Last), CStr(.Cells(R, "a"))) > 1 Then
            LR = Sheet7.Cells(Rows.Count, "A").End(xlUp).Row + 1
            .Cells(R, "A").Resize(1, 7).Copy Sheet7.Cells(LR, "A")
        End If
    Next
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[أبو عبد الرحمن سعيد]

أخى وحبيبى فى الله أبو عبد البارى

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

كل عام انتم بخير ورمضان كريم

 قبل تحميل المرفق ***** أشكرك على إهتمامك بردكم الكريم الذى أثلج صدرى

بارك الله فيكم وجزاكم الله خيرا

 

تم تعديل يونيو 23, 2016 بواسطه ابو عبدالرحمن بيرم

[ابو عبدالبارى]

استاذى ابو عبدالرحمن بيرم

مشكور لمرورك العطر  وكل الطرق تؤدى الى روما وكل عام وانتم بخير

[أبو عبد الرحمن سعيد]

أخى فى الله وحبيب قلبى استاذى ومعلمى // ابو حنين

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

هههههههه *** هههههههههه *** ههههههههه

والله زمااااااان ياأبو حنين والله العظيم حضرتك اللى ليك وحشة كبيرة

رغم اننى حذفت السطر المشار اليه إلا اننى لم أنتبه ان المرفق غير مرتب على النحو الصحيح 

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

قديش حلوة هالشيبة بتنقط حسن وهيبة
ولو كنا بالعمر كبار عنا قلوب ولاد زغار
مين قال الهوى عيبة

حلوة كتير كتير كتير يقولوا هالانســــان كبير
بيخلق طير الحب زغير وغير ما بيكبر ما بيطير
مين قال الهوى عيبة

كل مالك عم تتحلـّي صبية رح بتضلـّي
ليكي القمر شو ختيار بعده بيعطي الليل نهار
مين قال الهوى عيبه

كبير السن كبير القلب كبير النفس كبير الحب
ما في شب بيبقى شب ومن غير آخد ما في درب
يالله بعد هالغيبه نحط الشيبة عالشيبة

 بارك الله فيكم وأسعدك الله تعالى فى الدارين

تمت الافادة بكلا المرفقين وجزاكم الله خيرا

تم تعديل يونيو 24, 2016 بواسطه ابو عبدالرحمن بيرم

[ميدو63]

الاستاذ الفاضل

هل يمكن تحويله الى جدول ديناميكى يقبل ادرج ارقام هوية جديدة فى الشيت (بمعنى عندى جدول كل شهر اقوم بالاضافة على شيت ارقام الهوية ارقام جديدة)

[ميدو63]

هل من مساعدة فى ذلك