تهانى فكرى قام بنشر يوليو 27 مشاركة قام بنشر يوليو 27 السادة خبراء الاكسيل بعد التحية لو تكرمتم كنت اريد صياغة كود برمجى لترحيل التلاميذ من صفحة الصف الثانى الى صفحة المحولون من المدرسة عند الضغط على زر تحويل الطالب مع مسح البيانات في الصفحة الرئيسية سجل مستجدين - 2025.xlsm رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يوليو 27 مشاركة قام بنشر يوليو 27 اخي الفاضل صفحة الصف الثانى فارغة زيادة انك لم تدكر لنا ماهو النطاق او الاعمدة المرغوب ترحيلها يرجى اظافة بعض البيانات الوهمية على الملف مع ارفاق عينة للنتائج المتوقعة .ربما نستطيع مساعدتك رابط هذا التعليق شارك More sharing options...
تهانى فكرى قام بنشر يوليو 28 الكاتب مشاركة قام بنشر يوليو 28 (معدل) اخى الفاضل اريد ترحيل بيانات كل الاعمدة بناء على اختيار العمود الاخير وهو التحويلات فاذا اخترت "من المدرسة " من القائمة المنسدلة يقوم بنقل بيانات الطالب من شيت الصف الثانى الى شيت محولون من المدرسة ولك جزيل الشكر اخى الكريم سجل مستجدين - 2025.xlsm تم تعديل يوليو 28 بواسطه تهانى فكرى رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر يوليو 28 أفضل إجابة مشاركة قام بنشر يوليو 28 (معدل) تفضل اخي Option Explicit Sub filtre() Dim f$, Lastrow&, Cnt&, n&: f = "من المدرسة" Dim WS As Worksheet: Set WS = Sheets("الصف الثانى ") Dim src As Worksheet: Set src = Sheets("محولين الى المدرسة") Application.ScreenUpdating = False src.Range("B10:U" & src.Rows.Count).ClearContents Lastrow = WS.Range("V" & WS.Rows.Count).End(xlUp).Row For Cnt = 10 To Lastrow If UCase(WS.Range("V" & Cnt).Value) Like f Then n = n + 1 src.Range("B" & n + 9 & ":U" & _ n + 9).Value = WS.Range("B" & Cnt & ":U" & Cnt).Value End If Next Application.ScreenUpdating = True End Sub لتنفيد الكود تلقائيا عند التغيير في عمود التحويلات المدرسية (الصف الثانى ) Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("V10:V600")) Is Nothing Then Application.EnableEvents = False Application.Run ("filtre") Application.EnableEvents = True End If End Sub سجل مستجدين - 2025 V2.xlsm تم تعديل يوليو 28 بواسطه محمد هشام. 2 رابط هذا التعليق شارك More sharing options...
تهانى فكرى قام بنشر يوليو 28 الكاتب مشاركة قام بنشر يوليو 28 شكرا ليك مستر محمد على تعبك ، ربنا يبارك فيك رابط هذا التعليق شارك More sharing options...
تهانى فكرى قام بنشر يوليو 30 الكاتب مشاركة قام بنشر يوليو 30 On 7/28/2024 at 6:17 PM, محمد هشام. said: تفضل اخي Option Explicit Sub filtre() Dim f$, Lastrow&, Cnt&, n&: f = "من المدرسة" Dim WS As Worksheet: Set WS = Sheets("الصف الثانى ") Dim src As Worksheet: Set src = Sheets("محولين الى المدرسة") Application.ScreenUpdating = False src.Range("B10:U" & src.Rows.Count).ClearContents Lastrow = WS.Range("V" & WS.Rows.Count).End(xlUp).Row For Cnt = 10 To Lastrow If UCase(WS.Range("V" & Cnt).Value) Like f Then n = n + 1 src.Range("B" & n + 9 & ":U" & _ n + 9).Value = WS.Range("B" & Cnt & ":U" & Cnt).Value End If Next Application.ScreenUpdating = True End Sub لتنفيد الكود تلقائيا عند التغيير في عمود التحويلات المدرسية (الصف الثانى ) Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("V10:V600")) Is Nothing Then Application.EnableEvents = False Application.Run ("filtre") Application.EnableEvents = True End If End Sub سجل مستجدين - 2025 V2.xlsm 393.32 kB · 11 downloads استاذ محمد الكود لا يعمل ولا يقوم بتحويل و نقل الاسماء رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يوليو 30 مشاركة قام بنشر يوليو 30 (معدل) الكود يشتغل عندي بشكل جيد !!!! اخي قم بغلق الملف وإعادة تشغيله مع محاول تنفيذ الكود مباشرة بعد إضافة عبارة من المدرسة على بعض الصفوف ووافينا بالنتيجة تم تعديل يوليو 30 بواسطه محمد هشام. رابط هذا التعليق شارك More sharing options...
تهانى فكرى قام بنشر يوليو 30 الكاتب مشاركة قام بنشر يوليو 30 ازاى اشغل الكود مباشر مش فاهمه لما بضغط على تحويل طالب بتظهر رسالة x 400 رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يوليو 30 مشاركة قام بنشر يوليو 30 8 ساعات مضت, تهانى فكرى said: Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("V10:V600")) Is Nothing Then Application.EnableEvents = False Application.Run ("filtre") Application.EnableEvents = True End If End Sub اخي الكود يتم تنفيده تلقائيا عند تغيير القيمة في عمود من / إلى المدرسة بمجرد اختيار عبارة من المدرسة يتم نقل العمود الهدف الى ورقة (محولين الى المدرسة) دون الحاجة لاستخدام الازرار اما ادا كنت تريد تنفيده فقط عند الظغط على زر تحويل الطالب تفضل تم ربط الكود بالزر سجل مستجدين - 2025 V3.xlsm رابط هذا التعليق شارك More sharing options...
تهانى فكرى قام بنشر أغسطس 1 الكاتب مشاركة قام بنشر أغسطس 1 On 7/28/2024 at 6:17 PM, محمد هشام. said: تفضل اخي Option Explicit Sub filtre() Dim f$, Lastrow&, Cnt&, n&: f = "من المدرسة" Dim WS As Worksheet: Set WS = Sheets("الصف الثانى ") Dim src As Worksheet: Set src = Sheets("محولين الى المدرسة") Application.ScreenUpdating = False src.Range("B10:U" & src.Rows.Count).ClearContents Lastrow = WS.Range("V" & WS.Rows.Count).End(xlUp).Row For Cnt = 10 To Lastrow If UCase(WS.Range("V" & Cnt).Value) Like f Then n = n + 1 src.Range("B" & n + 9 & ":U" & _ n + 9).Value = WS.Range("B" & Cnt & ":U" & Cnt).Value End If Next Application.ScreenUpdating = True End Sub لتنفيد الكود تلقائيا عند التغيير في عمود التحويلات المدرسية (الصف الثانى ) Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("V10:V600")) Is Nothing Then Application.EnableEvents = False Application.Run ("filtre") Application.EnableEvents = True End If End Sub سجل مستجدين - 2025 V2.xlsm 393.32 kB · 11 downloads استاذ محمد الكود لا يعمل ولا يقوم بتحويل و نقل الاسماء تمام استاذ محمد شكرا لتعبك ومجهودك لكن فيه نقطة صغيرة ان البيانات لم تحذف من شيت الصف الثانى ولازالت موجودة فلو تكرم بس تعملى هذا التعديل البسيط وشكرا رابط هذا التعليق شارك More sharing options...
تهانى فكرى قام بنشر أغسطس 1 الكاتب مشاركة قام بنشر أغسطس 1 استاذ محمد اشكر تعبك و مجهودك ولكن تبقى جزئية بسية وهى نقل بيانات الصف وليس نسخة رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر أغسطس 20 مشاركة قام بنشر أغسطس 20 (معدل) اخي طريقة وشكل تصمييمك للملف لا تتناسب مع طلبك الاخير سيتم حدف خلايا القوائم المنسدلة مع فقدان التنسيقات والصيغ في الأعمدة المجاورة للجدول في حالة قمت بإعادة النظر في شكل الملف يمكنك استخدام الكود التالي Sub filtre2() Dim f$, lastRow&, Cnt&, n&, lr As Long Dim WS As Worksheet,src As Worksheet f = "من المدرسة" Set WS = Sheets("الصف الثانى ") Set src = Sheets("محولين الى المدرسة") Application.ScreenUpdating = False ' مسح المحتويات السابقة في الورقة الوجهة 'src.Range("B10:U" & src.Rows.Count).ClearContents <<===== غير مفعل lastRow = WS.Range("V" & WS.Rows.Count).End(xlUp).Row lr = src.Range("b" & src.Rows.Count).End(xlUp).Row For Cnt = lastRow To 10 Step -1 If UCase(WS.Range("V" & Cnt).Value) Like UCase(f) Then n = n + 1 src.Range("B" & n + lr & ":U" & n + lr).Value = WS.Range("B" & Cnt & ":U" & Cnt).Value ' حذف الصف من الورقة المصدر بعد نسخه WS.Rows(Cnt).Delete End If Next Cnt Application.ScreenUpdating = True End Sub تم تعديل أغسطس 20 بواسطه محمد هشام. رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان