طلب تعديل على كود للاستاذ الفاضل العيدروس

[اسكندراني]

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

مرفق كود للاستاذ الفاضل  العيدروس  فى تجميع  بيانات اعمدة محددة فى الصفحه الاجماليه  والكود يعمل بشكل ممتاز فى الملف رقم 3  ولكن عند تغير مكان الاعمدة المحددة  لم اتمكن من معرفه اين يمكن التعديل لكي يتماشي مع التعديل 

مرفق فى ملف 4 

يرجى المساعدة فى ذلك  والتوضيح ايضا اذا امكن  فى مكان التعديل لتعم الفائدة 

وجزاكم الله كل خير  وجزى الله الاستاذ العيدروس  على ما قدمه من كود رائع  خير الجزاء 

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

excel.rar

[ياسر خليل أبو البراء]

الأخ الكريم اسكندراني

قمت بشرح الكود بشكل سريع عله يفيدك في التعديل

كما قمت بتغيير الأرقام بأسماء الأعمدة المشار إليها لتسهيل عملية التعديل عليك حتى تستطيع أن تعدل على ملفك بنفسك

 

Sub Ali_Tr()
'تعريف المتغيرات
    Dim Shr As Worksheet
    Dim Wsh As Worksheet
    Dim Rng As Range
    Dim LR, II, Rww%, IM, RW
    Dim MOf, Amel, AGra
    Dim MOf1, Amel1, AGra1
'تعيين قيمة للمتغير ليساوي ورقة العمل الأولى المطلوب العمل عليها
    Set Wsh = Sheet1
    
    With Wsh
'تعيين آخر صف به بيانات في ورقة العمل الأولى
        LR = .Cells(.Rows.Count, 1).End(xlUp).Row
'إلى آخر خلية بها بيانات في العمود الخامس [D3] مسح النطاق بدايةً من الخلية
        .Range(.Cells(3, "D"), .Cells(LR, "E")).ClearContents
    End With
    
'حلقة تكرارية لكل أوراق العمل بالمصنف
    For Each Shr In ThisWorkbook.Worksheets
'إذا لم يكن اسم ورقة العمل يساوي اسم ورقة العمل الأولى يتم تنفيذ الأسطر التالية
'أي أنه يتم استثناء ورقة العمل الأولى من تلك الأسطر بينما تنفذ الأسطر على بقية الأوراق
        If Not Shr.Name = Wsh.Name Then
'بدء التعامل مع ورقة العمل التي انطبق عليها الشرط بأنها ليست الورقة الأولى
            With Shr
'حلقة تكرارية من الصف الثالث إلى آخر صف به بيانات
                For II = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row
'إذا لم تكن الخلية في العمود الرابع في الصف المحدد في الحلقة التكرارية فارغة
'فإذا لم تكن فارغة يتم تنفيذ الأسطر التالية [D] أي أنه يتم اختبار الخلية في العمود
'أما إذا كانت فارغة يتم الانتقال للصف التالي لاختبار الخلية التالية في العمود الرابع
                    If .Cells(II, "D") <> "" Then
'تعيين قيمة للمتغير ليساوي رقم الصف
                        Rww = .Cells(II, "B").Row
'حلقة تكرارية من الصف الثالث إلى آخر صف به بيانات في الورقة الأولى
                        For IM = 3 To Wsh.Cells(Wsh.Rows.Count, 1).End(xlUp).Row
'إذا كانت الخلية في العمود الثاني في أوراق الموظفين تساوي الخلية في العمود الثاني
'أي أنه يتم المقارنة بين اسم العميل في ورقة الموظف والورقة الأولى فإذا تطابق الاسم
'ينفذ التالي
                            If .Cells(Rww, "B") = Wsh.Cells(IM, "B") Then
'إذا كانت الخلية في العمود الرابع في الورقة الأولى ليست فارغة يتم تنفيذ التالي
                                If Wsh.Cells(IM, "D") = "" Then
'تعيين قيمة للمتغير ليساوي رقم الصف الذي يحوي اسم العميل من الورقة الأولى
                                    RW = Wsh.Cells(IM, "B").Row
'الخلية في العمود الرابع في الصف الذي يحوي اسم العميل في الورقة الأولى يساوي الخلية في العمود الرابع في الصف المحدد في الحلقة التكرارية
                                    Wsh.Cells(RW, "D") = .Cells(IM, "D")
'الخلية في العمود الخامس في الصف الذي يحوي اسم العميل في الورقة الأولى يساوي اسم ورقة عمل الموظف
                                    Wsh.Cells(RW, "E") = .Name
'أما إذا كانت الخلية في العمود الرابع في الأولى تساوي قيمة الخلية في العمود الرابع في ورقة الموظف
                                ElseIf Wsh.Cells(IM, "D") = .Cells(Rww, "D") Then
'تعيين قيمة للمتغير ليساوي قيمة الخلية في العمود الخامس ليحمل اسم الموظف
'تعيين قيمة للمتغير ليساوي قيمة الخلية في العمود الثاني ليحمل اسم العميل
                                    MOf1 = .Cells(IM, "E"): Amel1 = .Cells(IM, "B")
'تعيين قيمة للمتغير ليساوي قيمة الخلية في العمود الرابع ليحمل الإجراء
'تعيين قيمة للمتغير ليساوي قيمة الخلية في العمود الخامس في الورقة الأولى ليحمل اسم الموظف
                                    AGra1 = .Cells(IM, "D"): MOf = Wsh.Cells(IM, "E")
'تعيين قيمة للمتغير ليساوي قيمة الخلية في العمود الثاني في الورقة الأولى ليحمل اسم العميل
'تعيين قيمة للمتغير ليساوي قيمة الخلية في العمود الرابع في الورقة الأولى ليحمل الإجراء
                                    Amel = Wsh.Cells(IM, "B"): AGra = Wsh.Cells(IM, "D")
'إظهار رسالة في حالة التضارب في إدخال البيانات
'أي أنه عند اتخاذ إجراء لعميل عند أكثر من موظف تظهر رسالة تفيد بذلك
                                    MsgBox "البند المسمى  :" & " " & Amel & " موجود مسبقاً في ورقة   : " & " " & MOf & vbCrLf & "  بالاجراء  :" & " " & AGra & vbNewLine & " " & " وكرر في ورقة  :" & " " & .Name & " " & "   للعميل : " & Amel1
'التخطي للانتقال لصف جديد
                                    GoTo Skipper
                                End If
                            End If
Skipper:
'الانتقال للصف التالي في الورقة الأولى
                        Next IM
                    End If
'الانتقال للصف التالي في ورقة الموظف المعنية
                Next II
            End With
        End If
'الانتقال لورقة الموظف التالية
    Next Shr
End Sub

 

أرجو أن ينفعك الأمر

تقبل تحياتي

[اسكندراني]

الاستاذ الفاضل  / ياسر خليل ابو البراء 

جزاك الله خيرا وبالفعل هو شرح رائع للكود  واستطعت  من خلاله  فهمه  وتعديله حسب المطلوب 

وجزى الله خيرا  الاستاذ العيروس على كتابته و جزاك الله خير على الشرح 

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

 

[ياسر خليل أبو البراء]

أخي الكريم اسكندراني

الحمد لله أن تم المطلوب على خير

والفضل يرجع لله عزوجل ثم أخونا الحبيب علي (العيدروس)

جزاه الله عنا خير الجزاء وبارك الله لنا فيه ولا حرمنا منه