commandos1975 قام بنشر ديسمبر 28, 2012 قام بنشر ديسمبر 28, 2012 قام أحد الزملاء بهذا العمل وقمت بالتعديل لزيادة عدد تلاميذ الفصل برجاْ طريقة زيادة عدد الفصول حيث ان المجود هو 4 فصول اريد زيادها حتي 12 فصل classes.rar
يوسف عطا قام بنشر ديسمبر 28, 2012 قام بنشر ديسمبر 28, 2012 صباح الخيرات أخونا الغالى جمال بك تقبل تحياتى
يوسف عطا قام بنشر ديسمبر 28, 2012 قام بنشر ديسمبر 28, 2012 أخى كوماندوز تفضل هذا الملف وأعتقد أنه يلبى إحتياجك كما أنه مرن سهل التعديل عليه ويحقق عدد من المميزات كود الترحيل للفصول من شيت السجل يرحل لعدد 22 فصل وكل فصل 60 طالب كما يخرج إحصاء بعدد الطلبة فى كل فصل ويستخرج إحصاء بطلاب الفصل الواحد حسب الديانة وحالة القيد أتمنى يحقق مرادك Sub ترحيل_فصول() Dim Z As Integer, A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer, G As Integer, H As Integer, I As Integer, J As Integer, K As Integer, L As Integer, M As Integer, N As Integer, O As Integer, P As Integer, Q As Integer, R As Integer, S As Integer, T As Integer, U As Integer, V As Integer Sheets("1").Range("A7:DZ5000").ClearContents Sheets("2").Range("A7:DZ5000").ClearContents Sheets("3").Range("A7:DZ5000").ClearContents Sheets("4").Range("A7:DZ5000").ClearContents Sheets("5").Range("A7:DZ5000").ClearContents Sheets("6").Range("A7:DZ5000").ClearContents Sheets("7").Range("A7:DZ5000").ClearContents Sheets("8").Range("A7:DZ5000").ClearContents Sheets("9").Range("A7:DZ5000").ClearContents Sheets("10").Range("A7:DZ5000").ClearContents Sheets("11").Range("A7:DZ5000").ClearContents Sheets("12").Range("A7:DZ5000").ClearContents Sheets("13").Range("A7:DZ5000").ClearContents Sheets("14").Range("A7:DZ5000").ClearContents Sheets("15").Range("A7:DZ5000").ClearContents Sheets("16").Range("A7:DZ5000").ClearContents Sheets("17").Range("A7:DZ5000").ClearContents Sheets("18").Range("A7:DZ5000").ClearContents Sheets("19").Range("A7:DZ5000").ClearContents Sheets("20").Range("A7:DZ5000").ClearContents Sheets("21").Range("A7:DZ5000").ClearContents Sheets("22").Range("A7:DZ5000").ClearContents A = 7: B = 7: C = 7: D = 7: E = 7: F = 7: G = 7: H = 7: I = 7: J = 7: K = 7: L = 7: M = 7: N = 7: O = 7: P = 7: Q = 7: R = 7: S = 7: T = 7: U = 7: V = 7 Application.ScreenUpdating = False For Z = 2 To 5000 If Cells(Z, 5) = "1" Then Range("A" & Z).Resize(1, 22).Copy Sheets("1").Range("A" & A).PasteSpecial xlPasteValues Application.CutCopyMode = False A = A + 1 End If If Cells(Z, 5) = "2" Then Range("A" & Z).Resize(1, 22).Copy Sheets("2").Range("A" & B).PasteSpecial xlPasteValues Application.CutCopyMode = False B = B + 1 End If If Cells(Z, 5) = "3" Then Range("A" & Z).Resize(1, 22).Copy Sheets("3").Range("A" & C).PasteSpecial xlPasteValues Application.CutCopyMode = False C = C + 1 End If If Cells(Z, 5) = "4" Then Range("A" & Z).Resize(1, 22).Copy Sheets("4").Range("A" & D).PasteSpecial xlPasteValues Application.CutCopyMode = False D = D + 1 End If If Cells(Z, 5) = "5" Then Range("A" & Z).Resize(1, 22).Copy Sheets("5").Range("A" & E).PasteSpecial xlPasteValues Application.CutCopyMode = False E = E + 1 End If If Cells(Z, 5) = "6" Then Range("A" & Z).Resize(1, 22).Copy Sheets("6").Range("A" & F).PasteSpecial xlPasteValues Application.CutCopyMode = False F = F + 1 End If If Cells(Z, 5) = "7" Then Range("A" & Z).Resize(1, 22).Copy Sheets("7").Range("A" & G).PasteSpecial xlPasteValues Application.CutCopyMode = False G = G + 1 End If If Cells(Z, 5) = "8" Then Range("A" & Z).Resize(1, 22).Copy Sheets("8").Range("A" & H).PasteSpecial xlPasteValues Application.CutCopyMode = False H = H + 1 End If If Cells(Z, 5) = "9" Then Range("A" & Z).Resize(1, 22).Copy Sheets("9").Range("A" & I).PasteSpecial xlPasteValues Application.CutCopyMode = False I = I + 1 End If If Cells(Z, 5) = "10" Then Range("A" & Z).Resize(1, 22).Copy Sheets("10").Range("A" & J).PasteSpecial xlPasteValues Application.CutCopyMode = False J = J + 1 End If If Cells(Z, 5) = "11" Then Range("A" & Z).Resize(1, 22).Copy Sheets("11").Range("A" & K).PasteSpecial xlPasteValues Application.CutCopyMode = False K = K + 1 End If If Cells(Z, 5) = "12" Then Range("A" & Z).Resize(1, 22).Copy Sheets("12").Range("A" & L).PasteSpecial xlPasteValues Application.CutCopyMode = False L = L + 1 End If If Cells(Z, 5) = "13" Then Range("A" & Z).Resize(1, 22).Copy Sheets("13").Range("A" & M).PasteSpecial xlPasteValues Application.CutCopyMode = False M = M + 1 End If If Cells(Z, 5) = "14" Then Range("A" & Z).Resize(1, 22).Copy Sheets("14").Range("A" & N).PasteSpecial xlPasteValues Application.CutCopyMode = False N = N + 1 End If If Cells(Z, 5) = "15" Then Range("A" & Z).Resize(1, 22).Copy Sheets("15").Range("A" & O).PasteSpecial xlPasteValues Application.CutCopyMode = False O = O + 1 End If If Cells(Z, 5) = "16" Then Range("A" & Z).Resize(1, 22).Copy Sheets("16").Range("A" & P).PasteSpecial xlPasteValues Application.CutCopyMode = False P = P + 1 End If If Cells(Z, 5) = "17" Then Range("A" & Z).Resize(1, 22).Copy Sheets("17").Range("A" & Q).PasteSpecial xlPasteValues Application.CutCopyMode = False Q = Q + 1 End If If Cells(Z, 5) = "18" Then Range("A" & Z).Resize(1, 22).Copy Sheets("18").Range("A" & R).PasteSpecial xlPasteValues Application.CutCopyMode = False R = R + 1 End If If Cells(Z, 5) = "19" Then Range("A" & Z).Resize(1, 22).Copy Sheets("19").Range("A" & S).PasteSpecial xlPasteValues Application.CutCopyMode = False S = S + 1 End If If Cells(Z, 5) = "20" Then Range("A" & Z).Resize(1, 22).Copy Sheets("20").Range("A" & T).PasteSpecial xlPasteValues Application.CutCopyMode = False T = T + 1 End If If Cells(Z, 5) = "21" Then Range("A" & Z).Resize(1, 22).Copy Sheets("21").Range("A" & U).PasteSpecial xlPasteValues Application.CutCopyMode = False U = U + 1 End If If Cells(Z, 5) = "22" Then Range("A" & Z).Resize(1, 22).Copy Sheets("22").Range("A" & V).PasteSpecial xlPasteValues Application.CutCopyMode = False V = V + 1 End If Next For Y = 1 To 22 Sheets(Y).[a7] = 1 rrw = Sheets(Y).[A3000].End(xlUp).Row For Each cc In Sheets(Y).Range("a8:A" & rrw) cc.Value = cc.Offset(-1, 0) + 1 Next cc Next Y MsgBox ("الحمد لله تـــم ترحيل الطالبات كل إلى فصلها طبقاً للإحصاء التالى ") For X = 1 To 22 Y = Sheets(X).[A3000].End(xlUp).Row - 6 mssg = mssg & Chr(10) & Format(Y, "00") & " طالبة بفصل رقم : " & X Sheets(X).Select Range("A37:S100").Copy Range("G7").Select ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats Range("A37:F100").ClearContents Range("M1:S3").Select Selection.Copy Range("C38").Select ActiveSheet.Paste Range("A1").Select Application.CutCopyMode = False Next X MsgBox (" تم ترحيل عدد" & mssg) Range("A1").Select Application.ScreenUpdating = True End Sub قوائم فصول22 فصل.rar
دغيدى قام بنشر ديسمبر 28, 2012 قام بنشر ديسمبر 28, 2012 أخى اكريم تفضل وحتى 50 فصلا كل فصل 60 طالبا classes 2.rar
بن علية حاجي قام بنشر ديسمبر 28, 2012 قام بنشر ديسمبر 28, 2012 السلام عليكم ورحمة الله أخي الكريم، تجد في الملف المرفق تبسيطا واختصارا لنص كود أخي الكريم "يوسف عطا" جازاه الله عنا خير الجزاء... أخوكم بن علية قوائم فصول22 فصل.rar
commandos1975 قام بنشر ديسمبر 28, 2012 الكاتب قام بنشر ديسمبر 28, 2012 بارك اله فيكم جميعا منتدي في غاية الجمال اريد ان تكون الفصول في نفس الصفحة حتي تسهل الطباعة
أبو محمد عباس قام بنشر ديسمبر 28, 2012 قام بنشر ديسمبر 28, 2012 السلام عليكم ورحمة الله وبركاته الاساتذة الافاضل جزاكم الله خيرا وانتم تتسابقون لعمل الخير وابداء المساعدة لمن يحتاج وباكثر من طريقة جعلها الله في ميزان حسناتكم الاخ commandos 1975 بالنسبة لسؤالك في المشاركة 7 ان تكون الفصول في صفحة واحدة اعتقد يوجد حل في هذا الرابط للاستاذ محمود جزاه الله خيرا http://www.officena....howtopic=44632#
بن علية حاجي قام بنشر ديسمبر 28, 2012 قام بنشر ديسمبر 28, 2012 السلام عليكم ورحمة الله أخي الكريم، تم دمج كود الترحيل إلى كود الطباعة مع بعض التعديلات حيث عند النقر على زر "طباعة كل الفصول" يتم ترحيل كل فصل إلى ورقة "الفصول" مع طباعة هذا الفصل ثم الفصل الذي يليه ثم الذي يليه إلى آخر فصل... وقد تم إنشاء جدول إضافي في ورقة "البيانات 2013" لرواد الفصول... أرجو أن يكون العمل مستوفيا المطلوب... أخوكم بن علية قوائم الفصول.rar
أبو محمد عباس قام بنشر ديسمبر 29, 2012 قام بنشر ديسمبر 29, 2012 السلام عليكم ورحمة الله وبركاته الاستاذ والاخ بن علية حاجي جزاك الله خيرا عمل خرافي وفيه لمسة الابداع واضحة وظننت انها صعبه لكثرة الاوراق لكنني ايقنت بانه لاصعب عليكم ولا على الاساتذه الكبار في هذا المنتدى الرائع زادك الله سبحانه وتعالى علما ومعرفة ودمتم في رعاية الله وحفظه
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.