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

الحمد لله الذي بنعمته تتم الصالحات هذا بفضل الله عزوجل وحده .. فقل الحمد لله رب العالمين تقبل وافر تقديري واحترامي

الحمد لله الذي بنعمته تتم الصالحات .. لا تنسى النقر على إعجاب في المشاركة التي تم حل المشكلة بها .. تقبل تحياتي

أخي الكريم إن شاء الله طلبك سهل ويسير فقط ارفق ملف للعمل عليه Sub Button1_Click() 'PURPOSE: Find & Replace a list of text/values throughout entire workbook 'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault Dim sht As Worksheet Dim fndList As Variant Dim rplcList As Variant Dim x As Long fndList = Array("Absent ", "Trainer", "Trainer ", "Op_Training", "Op_Training ", "Peer_mentor", "Peer_mentor ", "Annual ", "Forced_Annu", "Forced_Annu ", "Avl_Annual", "Avl_Annual ", "Emergency ", "Sick ", "Planned_Sic", "Planned_Sic ", "Army", "Army ", "Planned_Arm", "Planned_Arm ", "Maternity", "Maternity ", "Bereavement", "Bereavement ") rplcList = Array("Absent", "HR", "HR", "HR", "HR", "HR", "HR", "Annual", "Annual", "Annual", "Annual", "Annual", "Emergency", "Sick", "Sick", "Sick", "Other", "Other", "Other", "Other", "Other", "Other", "Other", "Other") 'Loop through each item in Array lists For x = LBound(fndList) To UBound(fndList) 'Loop through each worksheet in ActiveWorkbook 'For Each sht In ActiveWorkbook.Worksheets ActiveSheet.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False 'Next sht Next x MsgBox "Replacemnt Done Sucssefully", 0, "Mohamed Youssef 11674" End Sub تقبل تحياتي

وعليكم السلام ورحمة الله وبركاته أخي الفاضل أبو يحيى الجبلاوي إليك الموضوع التالي فيه تفصيل للمطلوب إن شاء الله الرابط من هنا تقبل تحياتي

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

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

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

بارك الله فيك وجزاك الله كل خير أخي الحبيب محي الدين ، ولا داعي للاعتذار ..أنا فقط أردت النبيه عليك تقبل الله منا ومنكم صالح الأعمال .. تقبل تحياتي

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

نعم هكذا يكون العمل أخي الحبيب محمد بارك الله فيك وجزاك الله خيراً لرفعك لموضوع قيم ومتميز لأخونا الغالي مختار حسين ... العفريت الذي طال انتظاره (يظهر كل فترة ويختفي لفترات) نسأل الله لنا وله العافية في الدنيا والآخرة

وعليكم السلام ورحمة الله وبركاته أخي وحبيبي محي الدين أنت تعرف النظام .. مينفعش تقول تعديل بسيط جداً وتسكت .. قول ايه التعديل البسيط لأنه قد يكون بسيط في وجهة نظرك لكنه يحل المشكلة من جذورها ، وليستفيد الجميع ..ألا تريد أن تلقي علينا بعضاً مما عندك .. ربنا يجازيك خير ويبارك فيك تقبل وافر تقديري واحترامي

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

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

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

أخي العزيز عماد غازي بارك الله فيك وجزاك الله خير الجزاء .. وصدقني لا أستحق ولا حرف من قصيدتك الرائعة ، فأنا أقلكم علماً .. وأتعلم منكم جميعاً

أخي الكريم صلاح لم تحدد أي الإجابات قد أدى الغرض بالنسبة إليك ..ألم تقرأ الردود ووجدت أننا في حيرة من طلبك ولا ندري بالضبط ما المقصود من طلبك في المشاركة الأولى ؟؟ وكل اجتهد فأنا اعتمدت على القيمة المدخلة في الخلية A1 وأخي العزيز أبو حنين اعتمد على الشهر الحالي حسب التاريخ وأخونا سليم قد اعتمد على قيمة الخلية A1 تساوي 4 في الكود الذي قدمه أرجو الإيضاح حتى ولو حلت المسألة

حسب الملف المرفق في المشاركة الأولى إليكم الكود التالي .. والأفضل أن تدرسوا الكود بعناية لتتمكنوا من التعديل عليه بما يتلائم مع ملفاتكم Sub TestRun() Application.ScreenUpdating = False DeleteRow "بيانات الطلبة", 8 DeleteRow "إنجاز1", 8 DeleteRow "تحريرى ف 1", 8 DeleteRow "رصد الترم الأول", 8 DeleteRow "أعمال السنة", 8 DeleteRow "تحريرى ف 2", 8 DeleteRow "رصد الترم الثانى", 8 DeleteRow "كنترول شيت", 12 Application.ScreenUpdating = True End Sub Sub DeleteRow(sSheet As String, sRow As Long) Dim Ws As Worksheet Dim cnt As Long On Error Resume Next Set Ws = Sheets(sSheet) On Error GoTo 0 If Ws Is Nothing Then MsgBox "Sheet " & sSheet & " Doesn't Exist.", vbExclamation, "Sheet Not Found!" Exit Sub End If Application.ScreenUpdating = False On Error Resume Next Ws.Rows(sRow - 1).SpecialCells(xlCellTypeConstants, 3).ClearContents cnt = Sheets("بيانات المدرسة").Range("B10").Value Ws.Rows(sRow & ":" & (sRow + cnt - 2)).Delete Application.ScreenUpdating = True End Sub

أخي الكريم علي الرويلي إثراءً للحل المقدم من قبل أخونا سليم إليك حل بالأكواد .. قم بالإطلاع على الموضوع من الرابط التالي الرابط من هنا

أعتقد أن كود النسخ الذي ينسخ لجميع أوراق العمل يقوم بعملية المسح التي تقصدها .. تعني أن المسح يكون في الصف السابق للصف الهدف ..أي أنك إذا كتبت الصف رقم 8 .. تريد مسح البيانات كلها من الصف رقم 7 لا تنسى أنني أتحدث عن الإجراء الفرعي المخصص الآن DeleteRow "Sheet1",8 الصف الهدف أي بداية الحذف للصفوف وليس المسح يكون من الصف رقم 8 ... فهل المطلوب أن يتم مسح الصف السابق ألا وهو في هذه الحالة الصف رقم 7 .. وهل لمسح لجميع البيانات أم للقيم الثابتة فقط والإبقاء على المعادلات ..؟؟؟؟

أخي الفاضل ناصر سعيد بارك الله فيك وجزاك الله خيراً لمرورك العطر أخي الكريم ابن بنها أنا مش عارف ليه إنت معقد الأمور أكتر من اللازم Take It Easy أنا قلت لك أول سطر ... وآخر سطر .. (السطر اللي فيه اسم الإجراء دا طبيعي معروف والأخير اللي فيه كلمة End Sub دي القفلة ..يعني مليش دعوة بيهم) شوف المفروض يكون بالشكل ده Sub TestRun() Application.ScreenUpdating = False DeleteRow "بيانات الطلبة", 7 DeleteRow "إنجاز1", 7 DeleteRow "تحريرى ف 1", 7 DeleteRow "رصد الترم الأول", 7 DeleteRow "أعمال السنة", 7 DeleteRow "تحريرى ف 2", 7 DeleteRow "رصد الترم الثانى", 7 DeleteRow "كنترول شيت", 11 Application.ScreenUpdating = True End Sub بس خلاص ...شفت الموضوع مش صعب إزاي

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

وجزيت خيراً بمثل ما دعوت لي أخي العزيز عبد الواحد تقبل تحياتي

ضع السطر التالي في الكود المسمى TestRun في البداية Application.ScreenUpdating = False وفي نهاية الكود Application.ScreenUpdating = True

جرب التالي Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("E3")) Is Nothing Then UserForm2.Show End If ActiveSheet.Cells.Interior.ColorIndex = 0 ActiveCell.EntireRow.Interior.ColorIndex = 4 End Sub

قم بالتعديل على الكود بما يتاسب مع ملفك أخي الكريم .. الأمر مشروح بالتفصيل في الموضوع .. وتعمدت التفصيل لكي تتعلم كيف يمكنك استخدامه .. تعلم الصيد لأنني لن أعطي أسماكاً بعد اليوم