ترحيل البيانات وفتح صفحة جديدة لكل فصل بعد الترحيل

[مصطفى محمود مصطفى]

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

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

لكم وافر احترامي

ترحيل الى اوراق حسب الفصل.rar

[مصطفى محمود مصطفى]

لتقريب العمل اكثر يتم الترحيل باسماء الفصول لعدة صفحات بعدد الفصول

جزاكم الله خيرا

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

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

الكود الاول لاستحداث اوراق عمل جديدة حسب اسماء الفصول

Sub AddNewSheets()
    Dim ws As Worksheet
    Dim ShList As Range
    Dim C As Range
       With Worksheets("رصد الدرجات")
      Set ShList = .Range("E6:E" & .Range("E" & .Rows.Count).End(xlUp).Row)
    End With
  On Error Resume Next
For Each C In ShList
If Len(Trim(C.Value)) > 0 Then
  If Len(Worksheets(C.Value).Name) = 0 Then
    Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = C.Value
        End If
          End If
            Next
Call TrnsCls
End Sub

اما الكود الثانى هو مخصص لجلب بيانات الفصول

Sub TrnsCls()
Dim ws As Worksheet, Sh As Worksheet
Dim R As Long
Dim p As Long
Application.ScreenUpdating = False
p = 5
Set ws = Sheets("رصد الدرجات")
For Each Sh In Worksheets
For R = 6 To 204
If Trim(ws.Cells(R, 5).Value) = Trim(Sh.Name) Then
p = p + 1
Sh.Range(Sh.Cells(p, 1), Sh.Cells(p, 104)).Value = ws.Range(ws.Cells(R, 1), ws.Cells(R, 104)).Value
Sh.Cells(p, 1)=p-5
End If
Next
p = 5
Next
Application.ScreenUpdating = True
End Sub

يخصص زر للكود الاول فقط لان الثانى يتم استدعاؤه من خلال الكود الاول

التنسيق عليك ياصديقى

هذا و بالله التوفيق

تم تعديل يناير 7, 2018 بواسطه زيزو العجوز

[مصطفى محمود مصطفى]

السلام عليكم

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

لي طلب بسيط ان امكن في كل مرة يقوم بالترحيل يفتح ورقة جديدة وهذا سيجعل الاوراق المضافة في كل مرة كثيرة

هل يمكن ايقاف الكود عند اخر فصل دون اضافة الورقة الاضافية والتي تاتي برقم 5 ثم برقم 6 وهكذا

او اذا امكن اضافة ورقة واحد فقط لجميع المرات

لكم دعواتي بالصحة والعافية

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

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

اخى الكريم الكود مصمم على اساس عدم اضافة اى ورقة موجودة بالفعل 

الا فى حالة اضافة فصل جديد للورقة الاساسية

للتأكيد اليك الملف نفسه و اعتذر لأنه لا يوجد لدى وقت لا ضافة كود للتنسيق

 

ترحيل الى اوراق حسب الفصل.rar

[مصطفى محمود مصطفى]

السلام عليكم

اخي العزيز زيزو جزاكم الله خيرا

وغفر لكم . عمل رائع كروعة اخلاقكم العالية

شكرا لتعاونكم معي وجعلها الله في ميزان حسناتكم

لكم احترامي