تقسيم كشف

[محمد عدنان]

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

الملف المرفق يحتوي جدول العلامات  ل 65 طالب 

المطلوب بماكرو او طريقة بتصدير الملف بكشف بجيث تكون الترويسة ثابتة من السطر 1 الى 10 و التذييل اخر الاسطر بحيث يكون كل 45 طالب بكشف يعني

الكشف الاول  : الترويسة ثم 45 طالب  ثم التذييل الاسفل 

الكشف الثاني :  الترويسة و يكمل من 46 لغاية نهاية  الكشف ثم  التذيل في الاسفل 

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

 

1212.xlsx

[محي الدين ابو البشر]

عليكم السلام

ببساطة يمكن عملها يدويا

نسخ مرتين

ثمحذف الاسطر حسب الطلب

على كل اليك

Sub test()
    Application.ScreenUpdating = False
    Sheets("Table").Copy After:=Sheets(1)
    ActiveSheet.Name = "1-45"
    Rows("56:75").Delete Shift:=xlUp
    Sheets("Table").Copy After:=Sheets(2)
    ActiveSheet.Name = "1-46"
    Rows("11:55").Delete Shift:=xlUp
    Application.ScreenUpdating = False
End Sub

 

[محمد عدنان]

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

الاستاذ الكبير @محي الدين ابو البشر جزاك الله كل خير 

الكود يعمل بشكل جيد  لكن هل بالامكان ان يكون تصدير الى صفحة جديد  بدون معادلات  ان وجدت وبتسمية لخلية معينة .?

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

[محي الدين ابو البشر]

 وبتسمية لخلية معينة .?? لم أفهم

[محمد عدنان]

السلام عليكم 

المقصود ان  لا يتم حفظ الشيت  مع الشيت الاصلي  و ان يسمى باسم خلية معينة تكون قيمتها اسم الصف و الشعبة و لتكن BA4 و خلية BF4  و يصدر الشيت الى مكان تختاره 

كل الاحترام و التقدير لاهتمامك @محي الدين ابو البشر

[محي الدين ابو البشر]

Sub test()
    Application.ScreenUpdating = False
    Sheets("Table").Copy
    ActiveSheet.Name = Range("BA4") & "-" & Range("BF4")
    Rows("56:75").Delete Shift:=xlUp
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Range("BA4") & "-" & Range("BF4") & " 1-45.xlsx"
    ActiveWorkbook.Close
    Sheets("Table").Copy
    ActiveSheet.Name = Range("BA4") & "-" & Range("BF4")
    Rows("11:55").Delete Shift:=xlUp
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Range("BA4") & "-" & Range("BF4") & " 46-75.xlsx"
    ActiveWorkbook.Close
    Application.ScreenUpdating = False
End Sub

يتم حفظ النلفين في نفس مسار الملف الأساسي

[محمد عدنان]

السلام عليكم 

الاستاذ @محي الدين ابو البشر جزاك الله خير 

سؤال اذا كانت شيت Table تحتوي على معادلات عند الترحيل تعطي خطأ 

هل من طريقة لترحيل القيم بدون معادلات و يكون الترحيل لنفس الملف و يحتوي عل شيتاسمها  1-45 و  شيت الاخر من 46 - 90  و يكون اسم الملف هو اسماء الخلية  ؟

ما هو التعديل على كود 

اشكرك استاذ 

 

تم تعديل يوليو 26, 2022 بواسطه محمد عدنان

[محي الدين ابو البشر]

آسف نسيت موضوع المعادلات

Sub test()
    Application.ScreenUpdating = False
    Sheets("Table").Copy
    ActiveSheet.Name = Range("BA4") & "-" & Range("BF4")
    Rows("56:75").Delete Shift:=xlUp
    With Cells(7, 1).CurrentRegion: .Value = .Value: End With
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Range("BA4") & "-" & Range("BF4") & " 1-45.xlsx"
    ActiveWorkbook.Close
    Sheets("Table").Copy
    ActiveSheet.Name = Range("BA4") & "-" & Range("BF4")
    Rows("11:55").Delete Shift:=xlUp
    With Cells(7, 1).CurrentRegion: .Value = .Value: End With
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Range("BA4") & "-" & Range("BF4") & " 46-75.xlsx"
    ActiveWorkbook.Close
    Application.ScreenUpdating = False
End Sub

 

[محمد عدنان]

السلام عليكم 

جزاك الله كل خير  @محي الدين ابو البشر

هل بالامكان حفظ الشيت الاثنتان بمصنف واحد اسمه بالخلايا  BA4 و خلية 4BF  .

و حفظ الشيت الاثنتان داخل المصنف كل واحدة على شيت  ( شيت عدد 2 كل منها باسم اسم الاولى 1-46 و الثانية 46-75  .

 

[محي الدين ابو البشر]

اتمنى أن أكون قد قهمتك صح

Sub test()
    Application.ScreenUpdating = False
    Sheets("Table").Copy
    With Cells(7, 1).CurrentRegion: .Value = .Value: End With
    ActiveSheet.Copy After:=Sheets(1)
    Sheets(1).Name = "1 -45"
    Sheets(2).Name = "46 - 75"
    Sheets(1).Rows("56:75").Delete Shift:=xlUp
    Sheets(2).Rows("11:55").Delete Shift:=xlUp
    Path = ThisWorkbook.Path & "\" & Range("BA4") & "-" & Range("BF4")
    If Dir(Path, vbDirectory) = vbNullString Then MkDir (Path)
    ActiveWorkbook.SaveAs Path & "\" & Range("BA4") & "-" & Range("BF4")
    ActiveWorkbook.Close
    Application.ScreenUpdating = False
End Sub

 

[محمد عدنان]

السلام عليكم 

الاستاذ @محي الدين ابو البشر نعم هذا ما اريد 

جزاك الله كل خير  و اكرمك الله بالجنة