تعديل على الملف المرفق

[قنديل الصياد]

السلام عليكم اساتذتى الكرام

برجاء التعديل على الملف المرفق بعمل كود او دالة لترحيل مجموع درجة اللغة العربية وكذا درجة الرياضيات فى كنترول نصف العام الى كنترول اخر العام

وشرح تفصيلى للكود

ولو امكن العمل بالدالات عمل شرح تفصيلى للدالة

ولكم شكرى

 

[رجب جاويش]

تفضل أخى الفاضل

هذا كود يقوم بعمل المطلوب

Sub ragab()
Dim arr() As Double
Application.ScreenUpdating = False
On Error Resume Next
x = ActiveWorkbook.Name
WB = ActiveWorkbook.Path & "\" & "كنترول نصف العام" & ".xls"
Workbooks.Open Filename:=WB
LR = ActiveWorkbook.Sheets("ورقة1").Cells(Rows.Count, 3).End(xlUp).Row
ReDim arr(1 To LR - 12, 1 To 2)
For i = 13 To LR
    ii = ii + 1
    arr(ii, 1) = Cells(i, "H")
    arr(ii, 2) = Cells(i, "M")
Next
ActiveWindow.Close
T = 1
For R = 13 To LR
        Workbooks(x).Sheets("ورقة1").Cells(R, "D") = arr(T, 1)
        Workbooks(x).Sheets("ورقة1").Cells(R, "J") = arr(T, 2)
        T = T + 1
Next
Application.ScreenUpdating = True
End Sub

كنترول.rar

[قنديل الصياد]

اخى العزيز الاستاذ / رجب جاويش

كالعادة إبداع رائع

دعنى أنحى قلمى قليلا
أقف أحتراما لك
ولقلمك
وأشد على يديك لهذا الإبداع
الذى هز أركان المكان                                              
وأضع لك باقة ورد  لشخصك                                      

تم تعديل يونيو 9, 2013 بواسطه قنديل الصياد

[قنديل الصياد]

اخى العزيز واستاذى المبدع 

arr(ii, 1) = Cells(i, "H")
arr(ii, 2) = Cells(i, "M"

هذان السطرن لمادة اللغة العربية والرياضات لو زادت المواد اضيف اسطر اخرى بنفس القيم مع تغيير اسم خلية المادة

برجاء التغيير فى الكود على المواد التنى اضفتها ولك شكرى وامتنانى وتقديرى

 

تم تعديل يونيو 8, 2013 بواسطه قنديل الصياد

[رجب جاويش]

أخى الفاضل

سيكون الكود كالآتى

Sub ragab()
Dim arr() As Double
Application.ScreenUpdating = False
On Error Resume Next
x = ActiveWorkbook.Name
WB = ActiveWorkbook.Path & "\" & "كنترول نصف العام" & ".xls"
Workbooks.Open Filename:=WB
LR = ActiveWorkbook.Sheets("رصد اول").Cells(Rows.Count, 3).End(xlUp).Row
ReDim arr(1 To LR - 12, 1 To 4)
For i = 13 To LR
    ii = ii + 1
    arr(ii, 1) = Cells(i, "H")
    arr(ii, 2) = Cells(i, "M")
    arr(ii, 3) = Cells(i, "R")
    arr(ii, 4) = Cells(i, "W")
Next
ActiveWindow.Close
T = 1
For R = 13 To LR
        Workbooks(x).Sheets("رصد اول").Cells(R, "D") = arr(T, 1)
        Workbooks(x).Sheets("رصد اول").Cells(R, "J") = arr(T, 2)
        Workbooks(x).Sheets("رصد اول").Cells(R, "P") = arr(T, 3)
        Workbooks(x).Sheets("رصد اول").Cells(R, "V") = arr(T, 4)
        T = T + 1
Next
Application.ScreenUpdating = True
End Sub