تعديل كود نقل بيانات الى جدول (عنوان معدل)

[الشيباني1]

اخواني الاعزاء تحية طيبه جاد الاستاذ رجب جاويش بكود رائع لنقل بيانات الى جدول ، لدى محاولتي تعديل الكود ليتناسب مع الجدول المرفق لم افلح .

ارجو المساعده مع الامتنان

تعديل كود.zip

[الشيباني1]

ما زلت منتظرا لأني

لن يخيب بأذن الله ظني

[رجب جاويش]

أخى الفاضل

جرب هذا الكود وأخبرنى بالنتيجة

Sub ragab()

Application.ScreenUpdating = False

Dim LR1 As Integer, LR2 As Integer, LC As Integer

Dim cl As Range, cel As Range, i As Integer

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

LR1 = Sheets("الصادر").Cells(Rows.Count, "Q").End(xlUp).Row

LR2 = Sheets("ماده-وكيل").Cells(Rows.Count, "B").End(xlUp).Row

LC = [iv3].End(xlToLeft).Column

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

Set Rng1 = Range(Cells(3, 4), Cells(3, LC))

Set Rng2 = Sheets("الصادر").Range("Q5:Q" & LR1)

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

Range("D5:P" & LR2).ClearContents

For i = 5 To LR2

    For Each cl In Rng1

	    For Each cel In Rng2

		   If Cells(i, 2) = cel And cl = cel.Offset(0, 4) Then

			  Cells(i, cl.Column) = Cells(i, cl.Column) + cel.Offset(0, 1)

		   End If

	   Next

    Next

Next

Set Rng1 = Nothing

Set Rng2 = Nothing

Application.ScreenUpdating = True

End Sub

تعديل كود.rar

[عبدالله باقشير]

السلام عليكم

بارك الله فيك اخي الحبيب رجب

عمل اكثر من رائع

اثابك الله في الشهر الكريم اضعاف مضاعفة

تقبل تحياتي وشكري

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

ممكن بالمعادلة

SUMPRODUCT

=SUMPRODUCT(N(INDEX(MyRng;0;7)=D$3);N(INDEX(MyRng;0;3)=$B5);INDEX(MyRng;0;4))

حيث النطاق MyRng

=الصادر!$O$5:$U$100

المرفق 2003

بالمعادلات.rar

تحميل من المدونة في الرابط

http://khboor.posterous.com/sumproduct-92926

[رجب جاويش]

أستاذى الحبيب / عبد الله باقشير

هذا شرف كبير جدا لى أن يثنى على عمل لى أستاذى وأستاذ الكل الأستاذ / عبد الله باقشير

أستاذى الحبيب

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

أثابك الله الجنة على العلم الذى تنشره بين الناس

وجعلك الله من عتقاء شهر رمضان

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

[الشيباني1]

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

[الشيباني1]

اساتذتنا الكرام تحية طيبه اتساءل عن امكانية عكس المطلوب السابق اي اظهار المواد غير المسحوبه من قبل الوكلاء بوضع اشارة (x) على الماده التي لم يتم السحب منها مع تقديري واحترامي

[رجب جاويش]

أخى الفاضل

أرجو التوضيح أكثر

[الشيباني1]

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

1- المساعده في جعل الترحيل اسرع حيث هو الآن يأخذ وقتا

2- المساعده في وضع اشارة (X) في الخلايا التي لم تشغل بالارقام مع تلوينها بلون مغاير

مع الامتنان

تعديل كود3.zip

[رجب جاويش]

تفضل أخى

ولكن اعذرنى فانه بسبب كثرة البيانات فان الكود يستغرق حوالى 15 ثانية

وأستسمح أستاذى الحبيب / عبد الله باقشير فى استعارة الفورم الخاص بشريط التحديث

تعديل كود3.rar

[الشيباني1]

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

[alfahad]

بارك الله فيك استاذ رجب