كود ترحيل

[saad 77]

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

اخوتي محتاج كود يقوم بالترحيل بحسب رقم يوضع في الخلية مثلا G2 مثلا اذا وضعنا الرقم 22 يقوم الكود بترحيل 22 اسما من الاسماء  الموجودة في القائمة الرئيسية البالغ عددها مثلا 66 اسما ويضعها في الشيتات الموجودة في الملف . الاسماء يبدا تسلسلها من A6:A125 يقوم اولا بترحيل من A6 :A27 يضعها في A6 في الشيتات المستهدفة ومن ثم من A28:A49 يضعها في A47 ومن بعدها من A50:A71 يضعها في A88 وهكذا بقية الشيتات اي انه يقوم بالترحيل بحسب الرقم الذي نكتبه في الخلية G2 

ملف العمل فيه شرح للترحيل

جزاكم الله خيرا ووفقكم...

كود ترحيل.xlsx

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

عليكم السلام

شغلة عالسريع

لوكم ارجاء التأكد من الترقيم في جميع الصفحات 

Sub test()
Dim a
Dim i&, nn&, x&
Dim myArea As Range
With Sheets("الرئيسية اول")
a = Range(.Cells(6, 2), .Cells(6, 2).End(xlDown)).Cells
nn = .Cells(2, 7)
End With
For i = 2 To Sheets.Count - 1
    With Sheets(i)
      x = 1
            For Each myArea In .Columns(1).SpecialCells(2, 1).Areas
            
                myArea.Offset(, 2).Resize(nn).Value = Application.IfError(Application.Index(a, Evaluate("row(" & x & ":" & x + nn - 1 & ")"), [{1}]), "")
                 x = x + nn
            Next
    End With
Next
End Sub

 

[saad 77]

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

شكرا لسرعة الاستجابة والرد وفقكم الله لما يحب ويرضى ...

العفو استاذ كيف اجعل الكود يحذف الاسماء القديمة في الصفحات المرحل اليها قبل وضع الاسماء الجديدة وكيف اجعل الكود يقوم هو بترحيل التسلسل من القائمة الرئيسية لان القوائم كثيرة وهناك قوائم يكون وضع التسلسل فيها عن طريق معادلة الترقيم التلقائي بحسب الاسماء في العمود  C فكيف يمكن جعل الكود يتجاوز الترحيل  الى هذه القوائم لانه في حال عدم وجود ترقيم يعطي خطأ   .

 

تم تعديل فبراير 16, 2023 بواسطه saad 77

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

عليكم السلام 

لم افهم المطلوب

اقتباس

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

ترحيل رقم التسلسل

ام وضع تسلسل 1-30 في كل صفحة؟؟؟

[saad 77]

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

العفو استاذ ترحيل رقم التسلسل ورقم  القيد لكل اسم في كل قائمة 30 اسم تبدا الاولى من 1 - 30 والثانية من 31 - 60 والثالثة من 61 - 90 والرابعة من 91 - 120. اي اذا كان هناك اسم يقوم الكود بترحيل التسلسل الذي هو في العمود A ورقم القيد الذي هو في العمود B والاسم الذي هو في العمود  C  الى جميع الشيتات اما اذا لم يكن هناك اسم لايقوم الكود بترحيل التسلسل لان اعداد الاسماء تتفاوت مابين صف واخر . على ملف العمل هذا.

مع خالص شكري واحترامي لشخصك الطيب

كود ترحيل.xlsx

تم تعديل فبراير 19, 2023 بواسطه saad 77

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

تفضل 

عسى يكون المطلوب

Sub test()
Dim a
Dim i&, ii&, nn&, x&, xx&
Dim myArea As Range
With Sheets("الرئيسية اول")
a = Range(.Cells(6, 1), .Cells(6, 3).End(xlDown)).Cells
nn = .Cells(2, 7)
End With
For i = 2 To Sheets.Count - 1
    With Sheets(i)
      x = 1: xx = 0
           For ii = 0 To UBound(a) / nn
                .Cells(6 + xx, 1).Resize(30, 3).ClearContents
                .Cells(6 + xx, 1).Resize(nn, 3).Value = Application.IfError(Application.Index(a, Evaluate("row(" & x & ":" & x + nn - 1 & ")"), [{1,3,2}]), "")
                 x = x + nn: xx = xx + 41
   Next
    End With
Next
End Sub

 

[saad 77]

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

شكرا لك اخي واستاذي ربي يوفقك ويسعدك ويحفظك ويرزقك ويكثر من امثالك  

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

بارك الله

[saad 77]

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

 

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

العفو استاذ محي الدين ابو البشر كيف استثني بعض الشيتات من الترحيل اليها 

تم تعديل فبراير 21, 2023 بواسطه saad 77

[saad 77]

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

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

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

عليكم السلام

فقط أرجو توضيح الطلب أكثر أذا سمحت

ما هي الشيتات التي تريد الترحيل إليها أو الشيتات المستثناة من الترحيل

وهل الشيتات (المطلوب الترحيل إليها أو المستثناة) ثابتة دوماً أم متغيرة