dr.Mo7amed قام بنشر يونيو 7, 2017 مشاركة قام بنشر يونيو 7, 2017 مطلوب كود لترحيل البيانات اسم المادة والفصل من ورقة الفصول الى ورقة الاستاذ وجزاكم الله خيرا ترحيل لجدول الاستاذ.rar رابط هذا التعليق شارك More sharing options...
ابراهيم الحداد قام بنشر يونيو 7, 2017 مشاركة قام بنشر يونيو 7, 2017 السلام عليكم ورحمة الله انسخ هذا الكود وضعه فى موديول وخصص له زر ملحوظة هامة : ان لم تتطابق معك الاسماء فى الجدولين لن يعمل معك الكود بكفاءة Sub TransData() Dim Fsl As Worksheet, Tec As Worksheet Dim cel As Range Dim x As Integer, y As Integer Set Fsl = Sheets("fsol") Set Tec = Sheets("teacher") For Each cel In Fsl.Range("C6:G15") x = cel.Row y = cel.Column If cel.Value = Tec.Range("C2") Then Tec.Cells(x, y) = Fsl.Range("C2") Tec.Cells(x, y).Offset(-1, 0).Value = cel.Offset(-1, 0).Value End If Next End Sub رابط هذا التعليق شارك More sharing options...
dr.Mo7amed قام بنشر يونيو 7, 2017 الكاتب مشاركة قام بنشر يونيو 7, 2017 نسخت الكود ووضعته في مووديل لكن لم يظبط معي هل هناك معادلة توضع أو شيء لاني وضعت الكود ولم يظبط معي جزاكم الله خيرا استاذ زيزو رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يونيو 7, 2017 مشاركة قام بنشر يونيو 7, 2017 جرب هذا الماكرو Option Explicit Sub Give_Data() Dim r, c As Integer Dim Rfsol, Rteacher, Cel As Range Dim My_name As String Set Rfsol = Sheets("fsol").Range("c6:g15") Set Rteacher = Sheets("teacher").Range("c6:g15") Rteacher.ClearContents My_name = Sheets("teacher").Range("c2") For Each Cel In Rfsol If Cel = My_name Then r = Cel.Row: c = Cel.Column Sheets("teacher").Cells(r, c).Offset(-1, 0) = Cel.Offset(-1, 0) Sheets("teacher").Cells(r, c) = Cel End If Next End Sub رابط هذا التعليق شارك More sharing options...
dr.Mo7amed قام بنشر يونيو 7, 2017 الكاتب مشاركة قام بنشر يونيو 7, 2017 استاذ سليم واستاذ زيزو جزاكم الله خيرا هل ممكن وضع الكود في الملف المرفق لان خبرتي قليله في الاكواد وجزاكم الله عنا خير الجزاء ترحيل لجدول الاستاذ.rar رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يونيو 7, 2017 مشاركة قام بنشر يونيو 7, 2017 16 دقائق مضت, dr.Mo7amed said: استاذ سليم واستاذ زيزو جزاكم الله خيرا هل ممكن وضع الكود في الملف المرفق لان خبرتي قليله في الاكواد وجزاكم الله عنا خير الجزاء ترحيل لجدول الاستاذ.rar نظراً الى ان الاخ زيزو وضع لك نفس الكود تقريباً احببت ان اغير الى هذا الكود Option Explicit Sub Give_Data1() Dim Rfsol, Rteacher, Cel As Range Dim My_name As String Dim adr, adr1 As String Set Rfsol = Sheets("fsol").Range("c6:g15") Set Rteacher = Sheets("teacher").Range("c6:g15") Rteacher.ClearContents My_name = Sheets("teacher").Range("c2") For Each Cel In Rfsol If Cel = My_name Then adr = Cel.Address: adr1 = Cel.Offset(-1, 0).Address Sheets("teacher").Range(adr) = Cel Sheets("teacher").Range(adr1) = Cel.Offset(-1, 0) End If Next End Sub الملف مرفق ترحيل لجدول salimالاستاذ.rar رابط هذا التعليق شارك More sharing options...
dr.Mo7amed قام بنشر يونيو 7, 2017 الكاتب مشاركة قام بنشر يونيو 7, 2017 (معدل) الله يجزاك خير استاذ سليم على اهتمامك وسرعة ردك لكن اعذرني على الاطالة عند تغيير اسم المادة في ورقة فصول والضغط على الزر تصبح الخلية فارغة وهل يمكن تعديل الكود لكي يعمل بدون زر ؟ ولو تم اضافة فصل جديد فهل الكود يرحل منه لنفس الاستاذ ؟ واعتذر عن قلة خبرتي والاطالة وجزاكم الله عنا خيرا تم تعديل يونيو 7, 2017 بواسطه dr.Mo7amed رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان