ترحيل البيانات إلى أوراق عمل مختلفة تبعاً لمنطقة التجنيد

[عبدالله شيخون]

اعمل فى شئون طلبة واكتب جدول مكون من الأسم والعنوان والبطاقة وتاريخ الميلاد والرقم الثلاثى من ثلاخانات ثم المحافظة اريد بترحيل كل البيانات امام كل محافظة 

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

أخي الفاضل أهلا ومرحبا بك في المنتدى

يرجى ضغط الملف ثم إرفاقه

تقبل تحياتي

[عبدالله فاروق ابو ريان]

ارسل الملف الذي تعمل عليه حالياً ووضح المطلوب بالظبط

[عبدالله شيخون]

#اريد كود ترحيل كل الأعمدة عدا العمود c ,j ,l ,و وترحيل جميع المناطق كما فى العمود j كل منطقة فى شيت مع زر الترحيل والمسح

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

أخي الفاضل

راجع التوجيهات على هذا الرابط أولاً

http://www.officena.net/ib/index.php?s=d6ea3650efcc28c459c126a6e93260f7&showtopic=60147

 

يبدو أنك لم تستجيب للمشاركة رقم 2 و 3 ..

[عبدالله شيخون]

كود للترحيل بأسم الشيت

الترحييل.zip

[عبدالله شيخون]

مفيش حل للموضوع ده 

[عبدالله شيخون]

^{اليكم النموذج المرفق ويارب نلاقى حل}نموذج.zip

[عبدالله فاروق ابو ريان]

هل تقصد ترحيل بيانات من الجدول الرئيسي بناء على منطقة التجنيد

[عبدالله شيخون]

نعم اقصد ترحيل البيانات بناءا على منطقة التجنيد

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

الأخ الفاضل minor

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

 

يؤخذ عليك أنك لم توضح المطلوب بشكل كاف ..كان من المفترض وضع بعض النتائج للشكل المتوقع

عموما أنا عملت لك ورقة عمل مخفية اسمها Temp ممكن تغير شكلها بس دا هيبتعه تغير في بعض أسطر الكود

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

الكود يحذف أي ورقة عمل غير ورقة السجل ثم يقوم بإنشاء أوراق عمل جديدة تبعا للقيم الموجودة في منطقة التجنيد ثم يستدعي البيانات في كل ورقة عمل ..

جرب الملف بشكل مستفيض وأخبرنا بالنتائج

Sub CreateSheets()
    Dim WS As Worksheet, SH As Worksheet
    Dim Cell As Range, lRow As Long
    Set WS = Sheets("السجل")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        Temp.Visible = True
            For Each SH In ThisWorkbook.Sheets
                If SH.Name <> "السجل" And SH.Name <> "Temp" Then
                    SH.Delete
                End If
            Next SH
        
             For Each Cell In WS.Range("J5:J" & WS.Cells(Rows.Count, 10).End(3).Row)
                 For Each SH In ThisWorkbook.Sheets
                     If SH.Name = Cell.Value Then GoTo 1
                 Next SH
                 
                 Sheets("Temp").Copy After:=Sheets(Sheets.Count)
                 Sheets("Temp (2)").Name = Cell.Value
                 Range("A1").Value = ActiveSheet.Name
                 
1                Sheets(Cell.Value).Activate
                 With ActiveSheet
                     lRow = .Cells(Rows.Count, "F").End(3).Row + 1
                     .Range("A" & lRow).Value = lRow - 3
                     .Range("B" & lRow).Value = Cell.Offset(, -8).Value
                     .Range("C" & lRow).Value = Cell.Offset(, -6).Value
                     .Range("D" & lRow).Value = Cell.Offset(, -5).Value
                     .Range("E" & lRow).Value = Cell.Offset(, -4).Value
                     .Range("F" & lRow).Value = Cell.Offset(, -3).Value
                     .Range("G" & lRow).Value = Cell.Offset(, -2).Value
                     .Range("H" & lRow).Value = Cell.Offset(, -1).Value
                     .Range("I" & lRow).Value = Cell.Offset(, 1).Value
                 End With
            Next Cell
        Temp.Visible = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

لا تنسى أن تحدد أفضل إجابة التزاماً بقواعد وتوجيهات المنتدى

تقبل تحياتي

Transfer Data & Create Sheets.rar

[عبدالله فاروق ابو ريان]

جزاك الله خيرا استاذ ياسر خليل
كما تعودنا منك على الابداع في الاكواد

[ابو جودى]

فعلاً كود رائع و مميز استاذ ياسر

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

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

الأخ الحبيب عبد الله فاروق (يرجى تغيير اسم الظهور للغة العبرية ..وخلي بالك من العربية)

الأخ الحبيب عمرو طلبة

بارك الله فيكما وجزاكما الله خير الجزاء

ومشكور على كلماتكما الرقيقة ومشاعركم الطيبة

 

ولكن الصبر قليلاً فلم يحدد صاحب السؤال إذا ما كانت الإجابة مرضية بالنسبة إليه أم أن هناك أقوال أخرى

[عبدالله شيخون]

عمل ممتاز للأخ الفاضل ياسر بس ياريت شاشة ادخال بيانات للسجل

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

أخي الكريم

لا أفهم معنى شاشة إدخال

هل تقصد عمل فورم يمكن من خلاله إدخال البيانات؟؟

إذا كان الأمر كذلك يرجى طرح موضوع جديد بطلبك الجديد ، حيث أن لكل طلب موضوع مستقل

إذا تم الطلب الأول على خير فيرجى تحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي

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

اطلع على الرابط التالي لتعرف التفاصيل

http://www.officena.net/ib/index.php?showtopic=60147

ولن أكرر التنبيه عليك أخي الفاضل

فقد أرشدتك الطريق (تقبل تحياتي)

[ا بو سليمان]

ما شاء الله  اخ ياسر 

 

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

 

ونسال الله ان يرسلك لتغيثنا في الامطار 

تم تعديل مايو 5, 2015 بواسطه ا بو سليمان

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

أخي الحبيب أبو سليمان

أنت في منطقة جدباء لا كود فيها ولا ماء .. ههههههههه

أرى الأخوة الأفاضل مش مقصرين معاك

إنت بس وضح وخد الموضوع جزئية جزئية عشان تقدر توصل لحل وتفهم إزاي تعدل عليه بما يتناسب مع ملفك

الصبر في التعلم مطلوب

تقبل تحياتي

[عبد العزيز البسكري]

الأخ الفاضل minor

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

 

يؤخذ عليك أنك لم توضح المطلوب بشكل كاف ..كان من المفترض وضع بعض النتائج للشكل المتوقع

عموما أنا عملت لك ورقة عمل مخفية اسمها Temp ممكن تغير شكلها بس دا هيبتعه تغير في بعض أسطر الكود

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

الكود يحذف أي ورقة عمل غير ورقة السجل ثم يقوم بإنشاء أوراق عمل جديدة تبعا للقيم الموجودة في منطقة التجنيد ثم يستدعي البيانات في كل ورقة عمل ..

جرب الملف بشكل مستفيض وأخبرنا بالنتائج

Sub CreateSheets()
    Dim WS As Worksheet, SH As Worksheet
    Dim Cell As Range, lRow As Long
    Set WS = Sheets("السجل")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        Temp.Visible = True
            For Each SH In ThisWorkbook.Sheets
                If SH.Name <> "السجل" And SH.Name <> "Temp" Then
                    SH.Delete
                End If
            Next SH
        
             For Each Cell In WS.Range("J5:J" & WS.Cells(Rows.Count, 10).End(3).Row)
                 For Each SH In ThisWorkbook.Sheets
                     If SH.Name = Cell.Value Then GoTo 1
                 Next SH
                 
                 Sheets("Temp").Copy After:=Sheets(Sheets.Count)
                 Sheets("Temp (2)").Name = Cell.Value
                 Range("A1").Value = ActiveSheet.Name
                 
1                Sheets(Cell.Value).Activate
                 With ActiveSheet
                     lRow = .Cells(Rows.Count, "F").End(3).Row + 1
                     .Range("A" & lRow).Value = lRow - 3
                     .Range("B" & lRow).Value = Cell.Offset(, -8).Value
                     .Range("C" & lRow).Value = Cell.Offset(, -6).Value
                     .Range("D" & lRow).Value = Cell.Offset(, -5).Value
                     .Range("E" & lRow).Value = Cell.Offset(, -4).Value
                     .Range("F" & lRow).Value = Cell.Offset(, -3).Value
                     .Range("G" & lRow).Value = Cell.Offset(, -2).Value
                     .Range("H" & lRow).Value = Cell.Offset(, -1).Value
                     .Range("I" & lRow).Value = Cell.Offset(, 1).Value
                 End With
            Next Cell
        Temp.Visible = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

لا تنسى أن تحدد أفضل إجابة التزاماً بقواعد وتوجيهات المنتدى

تقبل تحياتي

بارك الله فيك أستاذنا الفاضل ياسر خليل .. جزاك الله خيرًا

[عبدالله شيخون]

اليكم الملف مشكورا وبه التعديلات المطلوبة

نموذج.zip

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

1-

2-

3-

4-

5-

 

اطلع عل التوجيهات (ويرجى للمرة الأخيرة تغيير اسم الظهور للغة العربية)

http://www.officena.net/ib/index.php?showtopic=60147

 

لن يلتفت إلى أكثر من طلب في موضوع واحد

[عبدالله شيخون]

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

نموذج.zip

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

النموذج المرفق يختلف عن المرفق الأول .. والطلب غير واضح الآن

بت لا أفهم طلبك !!

حاول توضح كأنك لسه بتطرح الموضوع من جديد ، لأني من البداية اشتغلت على حذف كل أوراق العمل الموجودة عدا الورقة الرئيسية وورقة الـ Temp ثم إنشاء أوراق عمل جديدة فيها البيانات التي تخص كل منطقة تجنيد ..

في النموذج الأخير في عمود منطقة التجنيد لاحظت بعض البيانات الغير مرتبطة بمنطقة التجنيد ...

 

يرجى إرفاق نموذج مشابه تماماً لقاعدة البيانات التي تعمل عليها .. حتى تكون الأمور أوضح .. وبالنسبة لورقة الـ Temp قم بتنسيقها بالشكل الذي ترغبه ....

[عبدالله شيخون]

اليكم الملف المرفق وبة المطلوب 

نموذج.zip

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

أخي الفاضل عمرو أمير

بص يا أمير يبدو أنك لم تفهم مطلبي

المطلوب نموذج بشكل النتائج المطلوب

المخرج النهائي شكله إزاي

وسؤال هام جداً هل أوراق العمل الخاصة بكل منطقة تجنيد ثابتة وموجودة ولا سيتم إنشاءها كما فعلنا وفي كل مرة الكود بيتنفذ بنحذفها وننشئها من جديد

حاول توضح لأني مش بحب أشتغل في ملف من غير تفاصيل كاملة

لأني تعبت في الملف الأول .. ولم يعجبك لأن التفاصيل لم تكن كافية على الإطلاق

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

أنا أكتر واحد بتوه لو معرفتش التفاصيل ..