يمكنك استعمال هذا الماكرو لنقل الأسماء الى الجداول المحصصة لكل طالب
لان عملية نسخ الجدول ولضقه اكثر من مرة ليست بالأمر السهل خاصة اذا كان عدد الطلاب كبير (50 أو اكثر)
فقط اضغط على الزر Give Data في الشيت Repport و ترى كل شيء امامك الجداول والاسماء فيها (بدون معادلات)
عندها تملأ الداتا الحاصة لكل تلميذ و بدورها تنتقل الى الشيت ترحيل
الماكرو
Option Explicit
Sub copy_Range()
Dim S As Worksheet
Dim R As Worksheet
Dim i%, k%, x
Dim Rg_To_Copy
Application.ScreenUpdating = False
Set S = Sheets("ST_names")
Set R = Sheets("Repport")
Set Rg_To_Copy = R.Range("A1:D13")
i = 2: k = 16
R.Range("A16").Resize(1000, 4).Clear
Do Until S.Range("A" & i).Offset(1) = vbNullString
Rg_To_Copy.Copy
R.Range("A" & k).PasteSpecial (xlAll)
R.Range("B" & k + 1).Resize(10).ClearContents
R.Range("D" & k + 1).Resize(10).ClearContents
With R.Range("A" & k)
.Offset(1, 1) = x + 2
.Offset(2, 1) = S.Range("D" & i + 1)
.Offset(1, 3) = S.Range("F" & i + 1)
End With
k = k + 15: x = x + 1: i = i + 1
Loop
Application.CutCopyMode = False
Application.ScreenUpdating = True
R.Cells(2, 1).Select
End Sub
الملف مرفق للاطلاع وإبداء الرأي
Haggag_1.xlsm