للمرة الالف أكرر يجب ان يكون اي جدول في اكسل مستقلاً عن اي بيانات خارجية و خاصة اذا كان هناك خلايا مدمجة
تم ادراج صف فارغ في كل جدول من الصفحة الاولى والثانية (مخفيين)
جرب هذا الماكرو

Option Explicit
Sub extract_Abscent()
Application.ScreenUpdating = False
Dim O As Worksheet, D As Worksheet
Dim RgO As Range, RgD As Range, Col%, Ro%, i%
Dim My_date As Date, My_str$: My_str = "غ"
Set O = Sheets("Output"): Set D = Sheets("data")
Set RgO = O.Range("A8").CurrentRegion
Set RgD = D.Range("A7").CurrentRegion
Ro = RgD.Rows.Count
If Ro > 1 Then
 RgD.Offset(1).Resize(Ro - 1).ClearContents
 End If
My_date = D.Range("D1")
Col = O.Range("D7:AH7").Find(My_date, LOOKAT:=1).Column
RgO.AutoFilter Col, My_str
For i = 1 To 3
RgO.Columns(i).SpecialCells(12).Copy
 D.Range("A8").Offset(0, i - 1).PasteSpecial (xlPasteValues)
Next

D.Range("A9").Select
If O.AutoFilterMode Then
 O.ShowAllData: RgO.AutoFilter
 End If
 Application.ScreenUpdating = True
End Sub

الملف مرفق

جرب هذا الكود
ليس عليك لا ان تكتب رقم الطالب واكسل يتكفل بالباقي (بعد الضغط على زر ترحيل)

Option Explicit
Sub test()
Dim x, y, D As Worksheet, O As Worksheet
Dim c As Range, s As String, cnt As Long
Dim Ro_Out As Range, Ro_In As Range
Dim F_rg As Range
Dim F_date As Range
Dim Claer_rg As Range

Set D = Sheets("data")
Set O = Sheets("Output")
Set Ro_Out = O.Range("A8:A" & O.Cells(Rows.Count, 1).End(xlUp).Row)
Set Ro_In = D.Range("A8:A" & D.Cells(Rows.Count, 1).End(xlUp).Row)
Ro_In.Offset(, 1).Resize(, 2).ClearContents

Set Claer_rg = O.Range("D7:AH7").Find(D.Range("d1"), lookat:=1)
    If Claer_rg Is Nothing Then
       MsgBox "This Date Not Exists": Exit Sub
    Else
      y = Claer_rg.Column
      O.Cells(8, y).Resize(1000).ClearContents
    End If

For Each c In Ro_In.Cells
'********************************
    Set F_rg = Ro_Out.Find(c, lookat:=1)
      If F_rg Is Nothing Then
        MsgBox "No data For cells:" & c.Address(0, 0)
        GoTo Next_C
      Else
        cnt = cnt + 1
        x = F_rg.Row
        O.Cells(x, y) = "X"
        c.Offset(, 1) = O.Cells(x, 2)
        c.Offset(, 2) = O.Cells(x, 3)
      End If
Next_C:
Next c
If cnt > 0 Then
  MsgBox "That is ALL " & cnt, vbInformation
End If
End Sub

الملف مرفق

الحمد لله أن هديت للحل .. لكن سؤال هل الشرط بالفعل أن تكون الخلية فارغة ؟

وعليكم السلام أخي العزيز أبو عبد الرحمن
والحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات