المساعدة في تكرار كود combobox في نفس ورقة العمل

[نبيل عبد الهادي]

السلام عليكم . في الملف المرفق كود إنشاء combobox في ورقة تسديد الاقساط في العمود ( C ) ارجوا المساعده في تكرار نفس الكود في نفس الورقة ولكن في العمود ( D ) مع ملاحظة اختلاف مدى الخلايا في ورقة 1 ليصبح  B1:B4

مع الشكر والتقدير

combobox.rar

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

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

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

رابط الكود من هنا

تقبل تحياتي

[نبيل عبد الهادي]

استاذ ياسر كل الشكر والتقدير لحضرتك وتفضلك بالرد ولكن عند تطبيق الكود في حدث الورقة يظهر لي هذا الخطأ لا اعلم ماهي المشكله .خالص تحياتي

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

جرب نسخ الكود من المشاركة التالية

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Sh As Worksheet
    Dim iLastRow As Long

    If Target.Cells.Count <> 1 Then
        Exit Sub
    End If

    With ComboBox1
        .LinkedCell = "": .Clear: .Visible = False
    End With

    If Not Intersect(Target, Range("C3:C779")) Is Nothing Then
        Set Sh = Sheet2
        iLastRow = Sh.Cells(Rows.Count, "A").End(xlUp).Row

        With ComboBox1
            .Top = Target.Top: .Left = Target.Left
            .Width = Target.Width: .Height = Target.Height
            .LinkedCell = Target.Address
            .List = Sh.Range("A1:A" & iLastRow).Value
            .Visible = True: .Activate
        End With
        SendKeys "%{DOWN}"
    End If

    If Not Intersect(Target, Range("D3:D779")) Is Nothing Then
        Set Sh = Sheet2
        iLastRow = Sh.Cells(Rows.Count, "B").End(xlUp).Row

        With ComboBox1
            .Top = Target.Top: .Left = Target.Left
            .Width = Target.Width: .Height = Target.Height
            .LinkedCell = Target.Address
            .List = Sh.Range("B1:B" & iLastRow).Value
            .Visible = True: .Activate
        End With
        SendKeys "%{DOWN}"
    End If
End Sub

لو حدثت نفس المشكلة لديك قم برفع الملف بعد وضع الكود داخله

[نبيل عبد الهادي]

استاذ ياسر انت شمعه تنير الدرب للمبتدئين . الكود يعمل 100% بعد تغير sheet2 الى ورقة6 كل الشكر والتقدير لحضرتك .الله يجعلها في ميزان حسناتك

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

7 ساعات مضت, نبيل عبد الهادي said:

استاذ ياسر انت شمعه تنير الدرب للمبتدئين . الكود يعمل 100% بعد تغير sheet2 الى ورقة6 كل الشكر والتقدير لحضرتك .الله يجعلها في ميزان حسناتك

أعتذر ربما هذا خطأي لأنني لم أنوه إلى تغيير اسم ورقة العمل (الاسم البرمجي) حيث أنني أفضل كتابة أسماء أوراق العمل باللغة الإنجليزية

عموماً حصل خير والحمد لله الذي بنعمته تتم الصالحات ، ومشكور أخي نبيل على كلماتك الرقيقة في حقي

تقبل تحياتي