معادلة جلب كل بيانات وكيل معين

[الشيباني1]

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

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

عنوان مخالف.... تم تعديل عنوان المشاركة ليدل أكثر على طلبك

كما أنه ليس هناك اى داعى لرفع الملف مضغوط طالما حجمه صغير - تجنباً لعدم اهدار وقت الأساتذة

خلاصه.xlsx

[Ali Mohamed Ali]

تفضل تم المطلوب بمعادلات المصفوفة

 

خلاصه1.xlsx

[سليم حاصبيا]

ربما كا المطلوب

 

Khoulassa.xlsx

[الشيباني1]

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

لي طلب قد يكون بسيطا عليكم هو امكانية اجراء الترحيل بكود  مع التقدير

[سليم حاصبيا]

لك ما تريد

الكود

Option Explicit

Sub get_data()
Dim w As Worksheet, K As Worksheet
Dim mot
Dim RwB As Range, RwG As Range
Dim F_rgB As Range, F_rgG As Range
Dim first_ro%, act_row%, m%
Set w = Sheets("Wakil"): Set K = Sheets("Khoulasa")
mot = K.Range("G2")
Set RwB = w.Range("A8").CurrentRegion.Columns(2)
Set RwG = w.Range("G8").CurrentRegion.Columns(1)
Union(K.Range("C6:E100"), K.Range("I6:K100")).ClearContents
m = 6
 Set F_rgB = RwB.Find(mot, lookat:=1)
   If Not F_rgB Is Nothing Then
    first_ro = F_rgB.Row: act_row = first_ro
    Do
      K.Cells(m, 3) = w.Cells(act_row, 4)
      K.Cells(m, 4) = w.Cells(act_row, 3)
      K.Cells(m, 5) = w.Cells(act_row, 5)
      Set F_rgB = RwB.FindNext(F_rgB)
      act_row = F_rgB.Row
      m = m + 1
    Loop Until act_row = first_ro
    End If
    m = 6
     '========================================
     Set F_rgG = RwG.Find(mot, lookat:=1)
   If Not F_rgG Is Nothing Then
    first_ro = F_rgG.Row: act_row = first_ro
    Do
      K.Cells(m, 9) = w.Cells(act_row, "I")
      K.Cells(m, 10) = w.Cells(act_row, "H")
      K.Cells(m, 11) = w.Cells(act_row, "J")
      Set F_rgG = RwG.FindNext(F_rgG)
      act_row = F_rgG.Row
      m = m + 1
    Loop Until act_row = first_ro
    End If
     '========================================
    
End Sub

الملف مرفق (مجرد ما تغير شيئاً ما في الخلية G2 الماكرو يقوم بعمله)

 

 

Khoulassa_by_Code.xlsm

[الشيباني1]

اساتذتنا الكرام اشكركم جدا وادامكم الرحمن لنا مرجعا