توزيع محتويات عمودين على أعمدة مجاورة في ورقة عمل

[إبراهيم عدلي منصور]

أأرجو من أساتذتي الأفاضل إفادتي حيث لدي شيت به الرقم السري  في عمود (A) مثلاً من رقم 1 وحتى 5000 ودرجة الطالب في عمود(B) بها درجات مختلفة مرضودة بالإضافة إلى غ (غياب) أريد السري  والدرجة أن يأتي في أعمدة (C) و (D) وهكذا وبعد انتهاء الصفحة الأولى يأخذ نفس الآلية مثل النموذج المرفق  

Book2.rar

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

أخي الكريم

يرجى تغيير اسم الظهور للغة العربية

كما يرجى توضيح المطلوب أكثر ..

اطلعت على الملف ووجدت أن هناك عمود للسري وعمود للدرجات في العمودين A و B ..هل تريد نسخ نفس السري ونفس الدرجات من هذين العمودين إلى بقية الأعمدة وحتى العمود L أم العمود M ..حيث أن آخر عمود هو عمود للسري؟؟؟

أم أنك تريد فقط نسخ عمود السري لبقية أعمدة السري؟؟

 

[إبراهيم عدلي منصور]

أستاذي الفاضل ياسر خليل

شكراً لسيادتكم لسرعة الاستجابة لمطلبي ولقد نفذت تعليمات سيادتكم وقمت بتغيير اسم الظهور باللغة العربية ... وبالنسبة للمطلوب فأريد السري بجواره الدرجة حسب عدد الأعمدة في الصفحة الواحد فلو الصفحة ستنتهي برقم 45 (A46) يأتي السري التالي في (C2) يأتي السري التالي ليكون 46 لينتهي برقم 90 في الخلية (c46)ثم (E2) تكون 91 وتنتهي الصفحة بخلية (E46) وهكذا إلى أن تنتهي الصفحة الأولى ثم نكرر بنفس الآلية الصفحة رقم 2 ثم التي تليها وتتكرر الدرجة أمام السري بنفس الآلية 

ولسيادتكم جزيل الشكر

أخوك الأصغر

إبراهيم عدلي منصور

رئيس قسم قياس الجودة بإدارة الحسينية التعليمية محافظة الشرقية

ت : 01222275992 - 01061810175

تم تعديل يناير 21, 2016 بواسطه إبراهيم عدلي منصور

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

أخي العزيز إبراهيم

بارك الله فيك على استجابتك لتغيير اسم الظهور للغة العربية

ما زال الطلب غير واضح تماماً بالنسبة لي .. هل كل صفحة من الصفحات الموجودة مستقله عن غيرها أي أنك تريد أن تعامل كل صفة بناءً على عمود السري .. وفي الصفحة التالية يتم التعامل مع عمود السري الجديد ...أم أنك تريد نقل السري والدرجات من بقية الصفحات للصفحة الأولى ..

بفضل إرفاق لشكل النتائج المتوقعة ...يكتفى بصفحتين لفهم الطلب بشكل جيد

تقبل تحياتي

 

[إبراهيم عدلي منصور]

تفضل أستاذي الفاضل أستاذ ياسر

والمرفق book2 به شيت السري والدرجة الذي سنأخذ منه وشيت آخر للمطلوب

وشكراً لسيادتكم

Book2.rar

تم تعديل يناير 21, 2016 بواسطه إبراهيم عدلي منصور

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

أخي الفاضل إبراهيم

جرب الكود التالي عله يفي بالغرض

Sub PopulateData()
    Dim Ws As Worksheet, Sh As Worksheet
    Dim I As Long, Col As Long
    Set Ws = Sheet1: Set Sh = Sheet2
    Col = 1
    
    Application.ScreenUpdating = False
        Sh.Range("A1").CurrentRegion.Offset(1).ClearContents
        
        With Ws
            For I = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 45
                .Cells(I, 1).Resize(45, 2).Copy
                Sh.Cells(Sh.Cells(Rows.Count, Col).End(xlUp).Row + 1, Col).PasteSpecial xlPasteValues
                If Col = 11 Then Col = 1 Else Col = Col + 2
            Next I
        End With
        
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

وإليك الملف المرفق ..غيرت فقط أسماء أوراق العمل ولن يؤثر على عمل الكود

 

 

Populate Data From One Column To Multiple Columns YasserKhalil.rar

[إبراهيم عدلي منصور]

أستاذي الجليل 

لا أجد من الكلمات التي أعبر بها عن مدى شكري وتقديري لجهدكم 

اللهم اجعل هذا العمل في ميزان حسناتك 

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

أخي العزيز إبراهيم

إليك إصدار آخر من الكود يقوم بتنسيق الخلايا كما تريد بدون اللجوء إلى التنسيق اليدوي ، كما يتم عمل فاصل للصفحات كما ترغب بعد كل 45 اسم بدون تدخل منك أيضاً

كل ما عليك ان تنقر على زر الأمر وبعدها لا تنساني بدعوة بظهر الغيب

Sub PopulateData()
    Dim Ws As Worksheet, Sh As Worksheet
    Dim I As Long, Col As Long, LR As Long, J As Long
    Set Ws = Sheet1: Set Sh = Sheet2
    Col = 1
    
    Application.ScreenUpdating = False
    
        With Sh
            .ResetAllPageBreaks
            With .Range("A1").CurrentRegion
                .Offset(1).Interior.Color = xlNone: .Offset(1).ClearContents: .Borders.LineStyle = xlNone
            End With
        End With
        
        With Ws
            For I = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 45
                .Cells(I, 1).Resize(45, 2).Copy
                Sh.Cells(Sh.Cells(Rows.Count, Col).End(xlUp).Row + 1, Col).PasteSpecial xlPasteValues
                If Col = 11 Then
                    Col = 1
                    LR = Sh.Cells(Rows.Count, 1).End(xlUp).Row
                    Sh.HPageBreaks.Add Before:=Sh.Cells(LR, 1).Offset(1, 0)
                Else
                    Col = Col + 2
                End If
            Next I
        End With
        
        With Sh
            With Sh.Range("A1").CurrentRegion
                .Borders.Weight = xlThin: .BorderAround Weight:=xlThin: .Range("A1").Select
            End With
            
            LR = Sh.Cells(Rows.Count, 1).End(xlUp).Row
            For J = 1 To 12 Step 2
                .Range(.Cells(2, J), .Cells(LR, J)).Interior.Color = RGB(192, 192, 192)
            Next J
        End With
        
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

Populate Data From One Column To Multiple Columns YasserKhalil V2.rar

[إبراهيم عدلي منصور]

أشكرك أستاذي الفاضل

ياسر خليل

والله أدعو لك ولا يعلم دعائي إلا الله

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

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

بارك الله فيك أخي الحبيب إبراهيم .. وجزيت خيراً بمثل ما دعوت

أنت لا تعرف مقدار محبتي لأهل الشرقية خصوصاً .. ففيها رجل من أحب الرجال إلى قلبي واسمه أ / رجب ويعمل في الإدارة (لا أعلم الإدارة التي يعمل بها) .. وهو من أحب الناس لقلبي

تقبل تحياتي وأهل الشرقية جمعاء

[ياسر العربى]

ايه ياعم ابو  البراء ما احنا من الشرقية بردو 

مفيش لينا من الحب دا جانب ولا ايه

كدا انا ازعل من كل من هو مطل على البحر الابيض المتوسط وجيرانها

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

أخي الحبيب ياسر العربي

أنا بعز كل أهل الشرقية قلت ... وإنت كمان ليك معزة خاصة (وممكن نخليها خروف لو تحب أو بقرة)

تقبل وافر تقديري وحبي واحترامي

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

 بعد اذن اخي ياسر

نفس الشيء لكن معادلات فقط مع مزيد من الخيارات

Book2 salim.rar

[قلم-الاكسل(عبدالعزيز)]

بارك الله فيك المهندس ياسر ابداع ما بعده ابداع وامتاع فيه غاية الاقناع وملفك قد امتع وهو عندي لا مثله اروع

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

عافاك المعافي كل داء وايدك بنوره القدسي ووسع عليكم من واسع نعمه ظاهرة وباطنة

وبوركت يداك الاستاذ سليم سلمت روحك الزكية من كل مكروه فعلا شغل متعوب عليه

 

[إبراهيم عدلي منصور]

كل الشكر والتقدير للأستاذ

ياسر خليل

والأستاذ سليم حاصبيا

والأستاذ عبدالعزيز والأستاذ ياسر العربي 

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

أخي العزيز إبراهيم عدلي

أهلاً بك في المنتدى ونورت بين إخوانك ..فأنت في بيتك الثاني في عائلة أوفيسنا التي لن تتكرر

تقبل وافر تقديري واحترامي