ابوذر

السلام عليكم ورحمة الله و بركته
ارجو المساعدة عاجل
 نرجو من الاساتذة الكرام على تعديل على مكرو في الملف اريد اضافة يبحث عن الاستاذ و يجلب له الفوج و يرحله الى الشيت خاص به المشكل في حصص
 الافواج عند كتابة عربية/رياضيات يجب تقسيم المادة و جلب استاذ المسند لها و ترحيله و شكرا
Sub t_booking() Dim Sh As Worksheet Sheets("مواقيت الأساتذة").Activate last_row = [B10000].End(xlUp).Row Set Sh = Sheets("حجز مواقيت الأقسام") last_row2 = Sh.[D10000].End(xlUp).Row For rr = 8 To last_row If Cells(rr, 2) = "" Then GoTo 10 t_name = Cells(rr, 2) For day_col = 6 To 14 Step 2 For j = 8 To last_row2 If Sh.Cells(j, day_col) = t_name Then t_time2 = Sh.Cells(j, 4) t_deprt = Sh.Cells(8 * Int(j / 8), 2) & " -- " & Sh.Cells(j, day_col - 1) new_col = day_col / 2 + 2 For i = 0 To 7 t_time = Cells(rr + i, 4) If t_time = t_time2 Then Cells(rr + i, new_col) = t_deprt Next i End If Next j Next day_col 10 Next rr end sub RGF_verمعدل.rar