مساعدة في تعديل على مكرو

[ابوذر]

السلام عليكم ورحمة الله و بركته

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

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

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

[ابوذر]

السلام عليكم ورحمة الله و بركته

ارجو المساعدة عاجل

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

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

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