degabro قام بنشر يونيو 6, 2011 مشاركة قام بنشر يونيو 6, 2011 أرجو من اساتذتي بالمنتدي حل هذه المشكلة الخاصة بي احتاج الي عمل كود ترحيل علي شيت aa وشيت bb بحيث انه عند كتابة بيانات في شيت aa وهو الخاص بالمحولين الي المدرسة يتم اضافة البيان الجديد الي مكانة الصحيح في الشيت الخاص به اي عندما تكون البيانات لطالب في الصف الخامس يتم ترحيل بياناته الي الشيت الخاص بالصف الخامس وهو 5 وهكذا وعندما اكتب بيانات في شيت bb وهو الخاص بالمحولين من المدرسة يتم حذف هذا الاسم من الشيت الخاص به مع مراعاة عدم تأثر اي معادلات موجودة بالشيت المرحل اليه ارجو الافادة اساتذتي Book1.zip رابط هذا التعليق شارك More sharing options...
degabro قام بنشر يونيو 7, 2011 الكاتب مشاركة قام بنشر يونيو 7, 2011 في انتظاركم يا اخواني؟ رابط هذا التعليق شارك More sharing options...
degabro قام بنشر يونيو 7, 2011 الكاتب مشاركة قام بنشر يونيو 7, 2011 يارب الرد ما يتأخرشي ؟ رابط هذا التعليق شارك More sharing options...
degabro قام بنشر يونيو 7, 2011 الكاتب مشاركة قام بنشر يونيو 7, 2011 ارب ماتكونوش نمتوا رابط هذا التعليق شارك More sharing options...
degabro قام بنشر يونيو 7, 2011 الكاتب مشاركة قام بنشر يونيو 7, 2011 لما لم تجيبوني ايها الزملاء الأفاضل هل سؤالي واستفساري بالصعوبة؟ رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر يونيو 8, 2011 مشاركة قام بنشر يونيو 8, 2011 السلام عليكم أخي العزيز هذا الكود للمحولين إلي المدرسة Sub ToSchool() ' ' Macro1 Macro ' Lst_R = [B1000].End(xlUp).Row For r = 12 To Lst_R cls = Cells(r, 3) For w = 1 To Worksheets.Count a = Format(cls, "0") If Sheets(w).Name = a Then Range("B" & r & ":R" & r).Copy new_R = Sheets(a).[B1000].End(xlUp).Row + 1 Sheets(a).Range("B" & new_R).PasteSpecial Paste:=xlPasteValues Sheets(a).Range("A" & new_R).Value = Sheets(a).Range("A" & new_R - 1).Value + 1 Range("A" & r & ":R" & r).ClearContents Application.CutCopyMode = False GoTo 10 End If Next w ' No sheets named this Class MsgBox ("No Class =" & cls) Exit Sub 10 ' exit FOR w Next r End Sub وهذا للمحولين من المدرسة Sub FromSchool() ' ' Macro1 Macro ' Lst_R = [B1000].End(xlUp).Row For r = 12 To Lst_R cls = Cells(r, 3) kid = Cells(r, 2) For w = 1 To Worksheets.Count a = Format(cls, "0") If Sheets(w).Name = a Then ' Range("B" & r & ":R" & r).Copy new_R = Sheets(a).[B1000].End(xlUp).Row For i = 11 To new_R kkid = Sheets(a).Cells(i, 2) If kkid = kid Then GoTo 15 Next i ' Not found the KID's name in this Class MsgBox ("No KID's named " & Chr(10) & kid & Chr(10) & "in Class " & a) Exit Sub 15 ' found the KID - exit FOR i (keep the Row number of Kid in i) Sheets(a).Range("B" & i + 1 & ":R" & new_R + 1).Copy Sheets(a).Range("B" & i).PasteSpecial Paste:=xlPasteValues Sheets(a).Range("A" & new_R).ClearContents Range("A" & r & ":R" & r).ClearContents GoTo 10 End If Next w ' No sheets named this Class MsgBox ("No Class =" & a) Exit Sub 10 ' exit FOR w Application.CutCopyMode = False Next r End Sub وتفضل المرفق أيضا المحولين.rar رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر يونيو 8, 2011 مشاركة قام بنشر يونيو 8, 2011 فقط للتذكير ارب ماتكونوش نمتوا قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراء القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف رابط هذا التعليق شارك More sharing options...
degabro قام بنشر يونيو 8, 2011 الكاتب مشاركة قام بنشر يونيو 8, 2011 اخي العزيز TareQ M أأسف بشدة علي جملتي التي قلتها في التعليق السابق ولكن هذا من قبيل العشم كما يقولون ونظرا لأني كنت في امس الحاجة لهذا الموضوع ولا انكر افضال هذا المنتدي علي وكذلك اعضاءه واكرر اسفي اخي العزيز رابط هذا التعليق شارك More sharing options...
degabro قام بنشر يونيو 8, 2011 الكاتب مشاركة قام بنشر يونيو 8, 2011 واشكرك اهخي العزيز علي مجهودك الرائع في مساعدتي وجعله الله في ميزان حساناتك رابط هذا التعليق شارك More sharing options...
degabro قام بنشر يونيو 8, 2011 الكاتب مشاركة قام بنشر يونيو 8, 2011 هناك استفسار يا اخي العزيز لما عند تطبيق الكود ويتم انتقال الاسم الي الفصل الخاص به وكذلك عند حذف الاسم يتم مسح جميع المعادلات الموجودة بالشيت الاصلي رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر يونيو 8, 2011 مشاركة قام بنشر يونيو 8, 2011 أخي الفاضل إرسل الشيت بالمعادلات رابط هذا التعليق شارك More sharing options...
degabro قام بنشر يونيو 8, 2011 الكاتب مشاركة قام بنشر يونيو 8, 2011 الشيت كما طلبت يا اخي العزيز والمعادلات في اعمدة السن في 1/10/2001 وكذلك في عمود اسم ولي الامر المحولين.zip رابط هذا التعليق شارك More sharing options...
ياسر الحافظ قام بنشر يونيو 8, 2011 مشاركة قام بنشر يونيو 8, 2011 الاخ / الاستاذ طارق : على مايبدو نحن محكومين بأن نقول دائما لحضرتك شكرا.... شكرا والله روعة وفقك الله ياسر الحافظ رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر يونيو 8, 2011 مشاركة قام بنشر يونيو 8, 2011 السلام عليكم أخي ديجابرو إستبدل الكود بالتالي سنقسم عملية النسخ واللصق ثلاث مقاطع لتلافي الخلايا التي بها معادلات Sub ToSchool() ' ' Macro1 Macro ' Lst_R = [B1000].End(xlUp).Row For r = 12 To Lst_R cls = Cells(r, 3) For w = 1 To Worksheets.Count a = Format(cls, "0") If Sheets(w).Name = a Then Range("B" & r & ":I" & r).Copy new_R = Sheets(a).[B1000].End(xlUp).Row + 1 Sheets(a).Range("B" & new_R).PasteSpecial Paste:=xlPasteValues Range("M" & r & ":N" & r).Copy Sheets(a).Range("M" & new_R).PasteSpecial Paste:=xlPasteValues Range("P" & r & ":R" & r).Copy Sheets(a).Range("P" & new_R).PasteSpecial Paste:=xlPasteValues Sheets(a).Range("A" & new_R).Value = Sheets(a).Range("A" & new_R - 1).Value + 1 Range("A" & r & ":I" & r).ClearContents Range("M" & r & ":N" & r).ClearContents Range("P" & r & ":R" & r).ClearContents Application.CutCopyMode = False GoTo 10 End If Next w ' No sheets named this Class MsgBox ("No Class =" & cls) Exit Sub 10 ' exit FOR w Next r End Sub Sub FromSchool() ' ' Macro1 Macro ' Lst_R = [B1000].End(xlUp).Row For r = 12 To Lst_R cls = Cells(r, 3) kid = Cells(r, 2) For w = 1 To Worksheets.Count a = Format(cls, "0") If Sheets(w).Name = a Then ' Range("B" & r & ":R" & r).Copy new_R = Sheets(a).[B1000].End(xlUp).Row For i = 11 To new_R kkid = Sheets(a).Cells(i, 2) If kkid = kid Then GoTo 15 Next i ' Not found the KID's name in this Class MsgBox ("No KID's named " & Chr(10) & kid & Chr(10) & "in Class " & a) Exit Sub 15 ' found the KID - exit FOR i (keep the Row number of Kid in i) Sheets(a).Range("B" & i + 1 & ":I" & new_R + 1).Copy Sheets(a).Range("B" & i).PasteSpecial Paste:=xlPasteValues Sheets(a).Range("M" & i + 1 & ":N" & new_R + 1).Copy Sheets(a).Range("M" & i).PasteSpecial Paste:=xlPasteValues Sheets(a).Range("P" & i + 1 & ":R" & new_R + 1).Copy Sheets(a).Range("P" & i).PasteSpecial Paste:=xlPasteValues Sheets(a).Range("A" & new_R).ClearContents Range("A" & r & ":I" & r).ClearContents Range("M" & r & ":N" & r).ClearContents Range("P" & r & ":R" & r).ClearContents GoTo 10 End If Next w ' No sheets named this Class MsgBox ("No Class =" & a) Exit Sub 10 ' exit FOR w Application.CutCopyMode = False Next r End Sub رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر يونيو 8, 2011 مشاركة قام بنشر يونيو 8, 2011 (معدل) الاخ / الاستاذ طارق : على مايبدو نحن محكومين بأن نقول دائما لحضرتك شكرا.... شكرا والله روعة وفقك الله ياسر الحافظ الأخ العزيز علي الروح القريب من القلب / ياسر الحافظ اللهم أعز سوريا وأهلها وسائر بلاد المسلمين أخي الكريم ، شاكرا جدا مرورك وكلماتك الرقيقة تقبل ودي واحترامي أخوكم طارق محمود (أبو زياد) تم تعديل يونيو 9, 2011 بواسطه TareQ M رابط هذا التعليق شارك More sharing options...
degabro قام بنشر يونيو 8, 2011 الكاتب مشاركة قام بنشر يونيو 8, 2011 بارك الله فيك يا اخي العزيز وافادنا دائما بعلمك الغزير ورزقك رزقا خلالا طيبا مباركا وبارك لك في زريتك رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.