Sub Test_YasserKhalil()
Dim xDate, xName, ws As Worksheet, sh As Worksheet, m As Long, iRow As Long
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Worksheets(1)
Set sh = ThisWorkbook.Worksheets(2)
xDate = Application.Match(ws.Range("C2").Value2, sh.Rows(5), 0)
If IsError(xDate) Then MsgBox "No Such A Date", vbExclamation: Exit Sub
m = ws.Columns(2).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
For iRow = 6 To m
xName = Application.Match(ws.Cells(iRow, 2).Value, sh.Columns(2), 0)
If IsError(xName) Then GoTo Skipper
If ws.Cells(iRow, 2).Value <> "" Then sh.Cells(xName, xDate).Value = ws.Cells(iRow, 13).Value
Skipper:
Next iRow
Application.ScreenUpdating = True
MsgBox "Done", 64
End Sub
ثانياً الكود يعتمد على الاسم ولاحظت وجود أسماء مكررة وهذا يؤدي إلى تعارض في النتائج المتوقعة (يفضل أن يكون لكل طالب رقم مميز كالرقم القومي أو كود بحيث يكون غير مكرر ويكون الاعتماد عليه في الكود)