السلام عليكم ورحمة الله و بركته
ارجو المساعدة عاجل
نرجو من الاساتذة الكرام على تعديل على مكرو في الملف اريد اضافة يبحث عن الاستاذ و يجلب له الفوج و يرحله الى الشيت خاص به المشكل في حصص
الافواج عند كتابة عربية/رياضيات يجب تقسيم المادة و جلب استاذ المسند لها و ترحيله و شكرا
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
ابوذر's post in مساعدة في تعديل على مكرو was marked as the answer