معادلة ترحيل لخانة مجموع الطالب

[راجي]

ترحيل مجموع الطالب قصاد اسمه المرتب اصلا حسب سنه 

وكذلك ترحيل اسم المدرسة المنقول منها 

Boo34234234k2ssss.rar

[ياسر خليل أبو البراء]

السلام عليكم

الموضوع غير مكتمل الأركان .. وضح بمزيد من التفاصيل وارفق ملف به ورقة عمل لشكل النتائج المتوقعة

[سليم حاصبيا]

يمكن ان يكون المطلوب

انظر الى الصفحة Result

 

EXTRACT_DATA.rar

[راجي]

صحيح اخي سليم هو المطلوب ولكن في نفس الصفحة وتحديدا اريد

المدرسة  في الخلية   s10

و المجموع في الخلية t10

اي بعد خلايا السنه في 1/10/2017

[سليم حاصبيا]

تستطيع ان تعدل في الكود ما تره مناسباً

اليك هذا التعديل

Option Explicit
Sub EXTRACT_DATA()
Dim lr%, LR1%
Application.ScreenUpdating = False
lr = Sheets("Salim").Cells(Rows.Count, 1).End(3).Row
Sheets("Result").Cells.Clear
 Sheets("Salim").Range("A8:k" & lr).Copy
 Sheets("result").Activate
 Range("p9").Select
Selection.PasteSpecial Paste:=-4163
Selection.PasteSpecial Paste:=-4122
Application.CutCopyMode = False

     With Sheets("Result")
          .Columns("t:y").Delete
          .Rows(10).Delete
             LR1 = .Cells(Rows.Count, "p").End(3).Row
                   With .Sort
                       .SortFields.Clear
                       .SortFields.Add Key:=Range("s9"), Order:=xlAscending
                    '=====================
                       .SetRange Range("p9:t" & LR1)
                       .Header = xlYes
                       .Apply
                   End With
          '============================
         .Range("p10:p" & LR1).Formula = "=IF(q10="""","""",MAX($p$9:p9)+1)"
         .Range("p10:p" & LR1).Value = .Range("p10:p" & LR1).Value
         .Range("p10").Select
      End With
Application.ScreenUpdating = True
  End Sub

اذا كنت تريد  ذلك في نفس الصفحة

هذا الكود

Option Explicit

Sub EXTRACT_DATA2()
Dim lr%, LR1%
Application.ScreenUpdating = False
lr = Sheets("Salim").Cells(Rows.Count, 1).End(3).Row
Sheets("Salim").Range("p8:t" & lr).Clear
Sheets("Salim").Range("A8:k" & lr).Copy

 Range("p8").Select
Selection.PasteSpecial Paste:=-4163
Selection.PasteSpecial Paste:=-4122
Application.CutCopyMode = False

     With Sheets("Salim")
          .Columns("t:y").Delete

             LR1 = .Cells(Rows.Count, "p").End(3).Row
                   With .Sort
                       .SortFields.Clear
                       .SortFields.Add Key:=Range("s8"), Order:=xlAscending
                    '=====================
                       .SetRange Range("p8:t" & LR1)
                       .Header = xlYes
                       .Apply
                   End With
          '============================
         .Range("p9:p" & LR1).Formula = "=IF(q9="""","""",MAX($p$8:p8)+1)"
         .Range("p9:p" & LR1).Value = .Range("p9:p" & LR1).Value
         .Range("p9").Select
      End With
Application.ScreenUpdating = True
  End Sub

 

[راجي]

جزاك الله كل خير لكن الكود حذف السن في 1/10/2017

[الأستاذ / محمد الدسوقى]

أخى الكريم / راجى

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

تفضل الملف المرفق به المطلوب إن شاء الله

وتم إظهار النتائج المطلوبة فى نفس ورقة العمل Salim    وتم إلغاء المعادلات كلها للأعمدة المطلوب نقلها

كما تم إظهار النتائج المطلوبة ـ  فى ورقة منفصلة  Result(2)  فاختر المناسب

أرجو المراجعة والتقييم

تقبل تحياتى

 

EXTRACT_DATA_II.rar

تم تعديل أغسطس 16, 2017 بواسطه الأستاذ / محمد الدسوقى

[راجي]

جزاكم الله كل خير فعلا هو ده المطلوب 

شكرا جدا لحضرتك 

[الأستاذ / محمد الدسوقى]

أخى الكريم

الحمد لله الذى بنعمته تتم الصالحات

تقبل تحياتى