برجاء تصحيح هذا الكود

[أبو چيداء]

Set ws1 = Sheets("HR DB")

Set ws2 = Sheets("3 Y History")

Set ws3 = Sheets("Plan 2015")

Dim arr()

Me.TextBox2 = ""

Me.TextBox4 = ""

Me.TextBox5 = ""

Me.TextBox7 = ""

Me.TextBox8 = ""

Me.TextBox9 = ""

Me.TextBox10 = ""

ListBox1.Clear

ListBox2.Clear

LR = ws1.Cells(Rows.Count, 1).End(xlUp).Row

LR2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row

LR3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row

Set Rng1 = ws1.range("A2:A" & LR)

Set Rng2 = ws2.range("A2:A" & LR2)

Set Rng3 = ws3.range("A2:A" & LR3)

x = Val(Me.TextBox1)

'=======================================

On Error Resume Next

For Each cl In Rng1

If cl = x Then

Me.TextBox2 = cl.Offset(0, 1)

Me.TextBox4 = cl.Offset(0, 3)

Me.TextBox5 = cl.Offset(0, 2)

Me.TextBox7 = cl.Offset(0, 4)

Me.TextBox8 = cl.Offset(0, 5)

Me.TextBox9 = cl.Offset(0, 6)

Me.TextBox10 = Format(cl.Offset(0, 8), "# ")

Exit For

End If

Next

For Each clll In Rng3

If clll = x Then

i = i + 1

ReDim Preserve arr(1 To 2, 1 To i)

arr(1, i) = clll.Offset(0, 20)

arr(1, i) = clll.Offset(0, 23)

End If

Next

R = UBound(arr, 1): RR = UBound(arr, 2)

Me.ListBox2.List = Application.WorksheetFunction.Transpose(arr)

For Each cll In Rng2

If cll = x Then

i = i + 1

ReDim Preserve arr(1 To 5, 1 To i)

arr(1, i) = cll.Offset(0, 2)

arr(2, i) = Format(cll.Offset(0, 3), "yyyy/mm/dd")

arr(3, i) = Format(cll.Offset(0, 4), "yyyy/m/dd")

arr(4, i) = cll.Offset(0, 5)

arr(5, i) = Format(cll.Offset(0, 6), "0%")

End If

Next

R = UBound(arr, 1): RR = UBound(arr, 2)

Me.ListBox1.List = Application.WorksheetFunction.Transpose(arr)

End Sub

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

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

[أبو چيداء]

اخى ياسر

الكود يعمل جيدا ولكنى اضفت ليست بوكس 2 ليأخذ داتا من شيت اخر ولكنه ياخذ نفس الداتا من الشيت الاخر

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

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

ضع الكود بهذا الشكل