المطلوب تعديل الكود

[نسورالجو]

السلام عليكم المطلوب التعديل على كود لتعبئة الكومبوبوكس من عمودين محتاح تعبئة البيانات  راسي مش افقي مثل الصورة

wor11.xlsm

[أ / محمد صالح]

يمكنك استعمال هذا الكود في حدث تهيئة النموذج والاستغناء عن إجراء add_comp

Private Sub UserForm_Initialize()
With Sheets("الصفحة الرئيسية")
Lr = .Cells(Rows.Count, 23).End(xlUp).Row
lr2 = .Cells(Rows.Count, 34).End(xlUp).Row
For n = 2 To lr2
Me.ComboBox1.AddItem .Range("ah" & n)
Next n
For n = 2 To Lr
Me.ComboBox1.AddItem .Range("w" & n)
Next n
End With
End Sub

مع تعديل خاصية عدد الأعمدة ColumnCount إلى 1 في خصائص ComboBox1

بالتوفيق 

[lionheart]

Rem In UserForm Module
Rem ------------------
Private Sub UserForm_Initialize()
    Dim a
    With ThisWorkbook.Worksheets(1)
        a = MergeRanges(.Range("AH2").Resize(Application.CountA(.Columns("AH"))), .Range("W2").Resize(Application.CountA(.Columns("W"))))
    End With
    Me.ComboBox1.List = a
End Sub

Rem In Standard Module
Rem ------------------
Function MergeRanges(ParamArray args())
    Dim e, cell As Range
    ReDim temp(0)
    For Each e In args
        For Each cell In e
            If cell <> "" Then
                temp(UBound(temp)) = cell
                ReDim Preserve temp(UBound(temp) + 1)
            End If
        Next cell
    Next e
    ReDim Preserve temp(UBound(temp) - 1)
    MergeRanges = Application.Transpose(temp)
End Function

 

[نسورالجو]

ما شاء الله الكودين ممتازين  مبدعين جزاكم الله خيرا

[أ / محمد صالح]

جميعا بإذن الله