تقسيم كل 20 موظف فى صفحه مستقله

[احمد حبيبه]

المطلوب استخراج  كل 20 موظف فى جدول مستقل فى صفحة مستقله 

تقسيم.rar

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

1-ليس من الضرورة رفع ملف يجتوي على اكثر من 1500 صف
   لان الماكرو الذي يعمل على صف واحد بستطيع العمل على الوف الصفوف

2- تم اختصار الملف الى حوالي 80 صف لمتابعة عمل الماكرو

3-الكود

Option Explicit

    Dim sh As Worksheet
    Dim New_sh As Worksheet
    Dim lr%, Cont#, i%, x%, k%
    Dim SectionName As Range
    Const How_Many = 20

'+++++++++++++++++++++++++++++++
Sub Del_sheets()
Application.DisplayAlerts = False
For Each sh In Sheets
 If sh.Name Like "Section*" Then
    sh.Delete
      End If
    Next
    Main.Select
Application.DisplayAlerts = True
End Sub
'++++++++++++++++++++++++++++++
Sub insert_Sheets()
Del_sheets
 Set SectionName = Main.Range("D3:K3")
 lr = Main.Cells(Rows.Count, 3).End(3).Row
 Cont = (lr - 1) / How_Many
    If Int(Cont) <> Cont Then
     Cont = Cont + 1
    End If
  Cont = Int(Cont)
 For i = 1 To Cont
 Sheets.Add(, Sheets(Sheets.Count)).Name = "Section_" & k * How_Many + 1
 k = k + 1
 SectionName.Copy
 With ActiveSheet.Range("D3")
  .PasteSpecial (xlPasteAll)
  .PasteSpecial (8)
End With
 Next
 Application.CutCopyMode = False
Main.Select
End Sub
'++++++++++++++++++++++++++++++++++++
Sub fil_data()
Application.ScreenUpdating = False
insert_Sheets
x = 4
  For Each New_sh In Sheets
   If New_sh.Name Like "Section*" Then
   Main.Range("D" & x).Resize(How_Many, 9).Copy
   New_sh.Range("D4").PasteSpecial (xlPasteAll)
   New_sh.Range("D4").PasteSpecial (8)
      x = x + How_Many
   End If
   Next
   Application.ScreenUpdating = True
   Main.Select
End Sub

4-الملف مرفق 

 

 

 

Taksim_Ahmad.xlsm

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

تم ادراج العضو احمد حبيبه على القائمة السوداء عندي (لا مساعدة من جهتي)  احر زيارة له قبل ساعة 
  دون حتى ابداء الرأي بالاجابة على سؤاله

[احمد حبيبه]

اخى الحبيب .. سليم حاصبيا

ما طلبته هو استخراج صفحات منفصله كما تفضل اخى واستاذى سليم

لكنى كنت اريدها صفحات منفصله كل صفحه فى ملف خاص به خارج الملف

جزاك الله خيرا .. وكثيرا ما ساعدتنى شخصيا فى مشكلات كثيره واجهتنى كما تفضلت الان وساعدتنى

وكثيرا ما استفدت منك ..... واشكرك جدا جدا جدا

عتاب المحب ..... بالفعل راجعت الموقع من موبايلى لاعرف ان كنت تلقيت اى حل لمشكلتى ام لا

ولكن كنت فى عملى الاضافى ... كما تعرف ظروف الحياة الصعبة .... ويعلم الله انى كنت انتوى بعد الرجوع للمنزل

ومراجعه الحل ...ان اتقدم بالشكر لكل من ساعدنى جزاهم الله عنى خيرا

وادراجى فى القائمة السوداء عندك احزننى جدا .... لكن على كل حال اشكرك جدا وجعله الله فى ميزان حسناتك

 

[hafez81]

رائع