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

[إبراهيم ابوليله]

الاخوه الافاضل

مرفق كود للاخ رجب جاويش

حاولت العمل عليه لكنى اخفقت

ارجو المساعدهBook1.rar

[احمد عبد الناصر]

السلام عليكم

 

جرب استبدال 

If cl = C11 Then

ب


If cl = C1l Then

 

تحياتي

[رجب جاويش]

بعد اذن أخى أحمد عبد الناصر

ولتكملة بقية البيانات

تفضل أخى ابراهيم

Sub ragab3()
 'كود استخراج بيانات
Dim LR As Integer
Dim LR1 As Integer
Set WS = Sheets("57")
Set WS1 = Sheets("58")
LR = WS.Cells(Rows.Count, 1).End(xlUp).Row
LR1 = WS1.Cells(Rows.Count, 1).End(xlUp).Row
x = 10
For Each cl In WS.Range("A5:A" & LR)
For Each cll In WS1.Range("A10:A" & LR1)
If cl = cll Then
Sheets("58").Cells(x, 2).Value = cl.Offset(0, 1).Value
Sheets("58").Cells(x, 3).Value = cl.Offset(0, 2).Value
Sheets("58").Cells(x, 4).Value = cl.Offset(0, 3).Value
x = x + 1
End If
Next
Next
End Sub

 

[إبراهيم ابوليله]

اخى الكريم رجب

بارك الله فيك

ولكنى لم اجد تعديل منك على الكود

وبعد ان رأيت الكود المرفق منك

ومراجعته مع الكود الذى قمت انا بارفاقه

فلم اجد فيه اختلاف

ومع ذلك كان الكود لا يعمل معى

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

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

[إبراهيم ابوليله]

الاخوه الافاضل

لقد واجهتنى مشكله

فى عمل الكود

انه عند الاستخراج لاكثر من رقم

يتم استخراج البيانات بالترتيب

دون الرجوع الى الاسم او الرقم المطلوب استخراج البيانات له

ارجو النظر الى المرفقBook1.rar

[رجب جاويش]

أخى ابراهيم

فعلا الكود يبدو كما هو دون تغير

ولكن كان الاختلاف بسيط جدا جدا

وهو كما أوضح أخى أحمد عبد الناصر فى مشاركته

الكلمة cll  فى السطرين التاليين كانت غير متماثلة

For Each cll In WS1.Range("A10:A" & LR1)
If cl = cll Then

حيث كانت احداهما تنتهى بحرف L  والأخرى تنتهى برقم 1

[إبراهيم ابوليله]

الاخ الكريم رجب

بارك الله فيك

وفعلا كما قلت

ولكن ماذال يوج خطأ

ارجو النظر الى طلبى فى المشاركه رقم 5

بارك الله فيك

[احمد عبد الناصر]

السلام عليكم

 

بعد اذن استاذنا رجب 

 

 

جرب هذا 

Sub ragab3()
 'ßæÏ ÇÓÊÎÑÇÌ ÈíÇäÇÊ
Dim LR As Integer
Dim LR1 As Integer
Set WS = Sheets("57")
Set WS1 = Sheets("58")
LR = WS.Cells(Rows.Count, 1).End(xlUp).Row
LR1 = WS1.Cells(Rows.Count, 1).End(xlUp).Row
x = 10
For Each cll In WS1.Range("A10:A" & LR1)
For Each cl In WS.Range("A5:A" & LR)
If cl = cll Then
Sheets("58").Cells(x, 2).Value = cl.Offset(0, 1).Value
Sheets("58").Cells(x, 3).Value = cl.Offset(0, 2).Value
Sheets("58").Cells(x, 4).Value = cl.Offset(0, 3).Value
x = x + 1
Exit For
End If
Next
Next
End Sub

 

تحياتي

[إبراهيم ابوليله]

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

بارك الله فيك

[رجب جاويش]

ولاثراء الموضوع

هذا تعديل آخر

Sub ragab3()
Dim LR As Integer
Dim LR1 As Integer
Set WS = Sheets("57")
Set WS1 = Sheets("58")
LR = WS.Cells(Rows.Count, 1).End(xlUp).Row
LR1 = WS1.Cells(Rows.Count, 1).End(xlUp).Row
For Each cll In WS1.Range("A10:A" & LR1)
For Each cl In WS.Range("A5:A" & LR)
If cl = cll Then
Sheets("58").Cells(cll.Row, 2).Value = cl.Offset(0, 1).Value
Sheets("58").Cells(cll.Row, 3).Value = cl.Offset(0, 2).Value
Sheets("58").Cells(cll.Row, 4).Value = cl.Offset(0, 3).Value
End If
Next
Next
End Sub

 

[إبراهيم ابوليله]

الاخ الحبيب رجب

بارك الله فيك

اكوادك فعلا اخى الحبيب اكثر من رائعه

الاخ احمد عبد الناصر

مشكورا على المشاركه

لكن يميز كود الاخ رجب

انه فى حاله وجود فراغ بين الارقام يتم تجاهل الفراغ

ثم الترحيل الى الصف الذى يليه

اما فى الكود المعدل منك

لو قمت مثلا بحزف رقم خمسه وظلت الخليه فارغه

فستجد ان الترحيل يتم فى الخلايا المقابله للخليه الفارغه

Book1.rar