ترحيل العلامات

[محمد عدنان]

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

ارجو المساعدة بماكرو يقوم بترحيل عمود مجموع الفصل الاول و مجموع الفصل الثاني و المعدل و بيانات الطالب  من  صفحة Mark All    كل حسب العمود المخصص له  في صفحة  Table

 821173841_Tabele2022.xlsx

[ابراهيم الحداد]

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

استخدم الكود التالى

Sub TrMarks()
Dim ws As Worksheet, Sh As Worksheet
Dim Arr As Variant, Tmp As Variant
Dim LR As Long, i As Long, j As Long, p As Long
Dim ArCol
Set Sh = Sheets("Table")
Sh.Range("A11:AW" & Sh.Range("B" & Rows.Count).End(3).Row+11).ClearContents
Set ws = Sheets("Mark All")
LR = ws.Range("B" & Rows.Count).End(3).Row
ArCol = Array(1, 2, 3, 4, 5, 6, 7, 13, 18, 19, 24, 29, 30, 35, 40, 41, _
46, 51, 52, 57, 62, 63, 68, 73, 74, 79, 84, 85, 90, 95, 96, 101, 106, _
107, 112, 117, 118, 123, 128, 129, 134, 139, 140, 145, 150, 151, 156, 161, 162)
Arr = ws.Range("A9:FF" & LR).Value
ReDim Tmp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If True Then
p = p + 1
For j = LBound(ArCol) To UBound(ArCol)
Tmp(p, j + 1) = Arr(i, ArCol(j))
Tmp(p, 1) = p
Next
End If
Next
If p > 0 Then Sh.Range("A11").Resize(p, UBound(Tmp, 2)).Value = Tmp

End Sub

 

تم تعديل أكتوبر 27, 2022 بواسطه ابراهيم الحداد

[محمد عدنان]

السلام عليكم 

الاستاذ @ابراهيم الحداد  جزاك الله كل خير و نفع الله بعلمك لجميع المسلمين  ..كل الاحترام و التقدير لك و جزاك الله الجنة