سليم حاصبيا

تعديل الكود بحيث يعمل على اوراق محددة اخي ابو حنين/ يجب ان تزيل الفاصلة من جانب السطر if اخضر اللون وتحدد مكان علامات الاستفهام ارقام الأوراق المستثناة Sub add_one() Dim sh As Worksheet Application.ScreenUpdating = False For i = 1 To Sheets.Count 'If i = ?? or i=?? or i=?? or i=??then go to 1 Sheets(i).Select lr = Cells(Rows.Count, 7).End(xlUp).Row y = Application.WorksheetFunction.IsNumber(Cells(7, 7)) y1 = Application.WorksheetFunction.IsNumber(Cells(21, 7)) If y And y1 And Cells(lr, 7) > 0 _ And Cells(lr, 21) > 0 Then Application.EnableEvents = False Cells(lr, 7) = Cells(lr, 7) + 1: Cells(lr, 21) = Cells(lr, 21) + 1 Application.EnableEvents = True End If 1: Next Sheets(1).Select Application.ScreenUpdating = True End Sub

تم تعديل الكود حسب ما تريد هذا الكود يعمل على كل الأوراق اذا اردت ان يعمل على بعضها سأرسل لك التعديل جمع اخر صف معدل ابو حنين.rar

استاذ ابو حنين لك هذا لكن علي ان أذهب الى العمل الان انشاء الله بعد الظهر سأحاول ان افعل شيئاً

اخي صلاح ()Sub Remove_All_Comments_From_Worksheet Cells.ClearComments End Sub لحذف التعليقات استعمل الكود التالي

استاذ محمد /بعد السلام اليك هذه القائمة المنسدلة المتحركة والتي تستجيب الى اي شيء يتجدد في البيانات DAT VAL FLEXIBLE.rar

جرب هذا الشيء 'تضيف الى الكود ما يلي Dim MyArray As Variant 'تستطيع ان تضيف ما تشاء MyArray = Array("Sheet1", "Sheet2", "Sheet3") Sheets(MyArray).Select For Each Sheet In MyArray '################################################## ' تضع الكود هنا '################################################### Next End Sub

اخي لا حاجة للكود اكتب مباشرة باللغة التي تريدها شرط ان تكون اللغة المطلوبة مثبتة عندك على لجهاز

استاذ طارق الحل مرفق طارق.rar

اليك الملف مع الكود (معدلاً بعض الشيء) ابو حنين جمع اخر صف.rar

استاذ طارق اليك هذا الكود عسى ان ينال اعجابك Sub del_without_function() Dim wh As Worksheet Dim myrange As Range Set wh = ActiveSheet Set myrange = wh.Range("b2:z100") For Each cel In myrange If cel.HasFormula = False Then cel.ClearContents End If Next End Sub

استاذ ابو حنين جرّب هذا الكود Sub add_one lr = Cells(Rows.Count, 7).End(xlUp).Row For r = 8 To lr ((y = Application.WorksheetFunction.IsNumber(Cells(7, 7 ((y1 = Application.WorksheetFunction.IsNumber(Cells(21, 7 If y And y1 And Cells(lr, 7) > 0 _ And Cells(lr, 21) > 0 Then Cells(lr, 7) = Cells(lr, 7) + 1: Cells(lr, 21) = Cells(lr, 21) + 1 End If Next End Sub

الحل مرفق Book 10% (1).rar

السلام عليكم أخي يسري اليك هذا الملف /عليك فقط ان تملأ القائمة بما يناسبك في حال اعجبك اضغط أعجبني و شكراً تفتيش عن اسم.rar

استاذ رجب أجمل المنافسات هي الشريفة منها والتي تكون نحو الأفضل نِعْمَ المنافسة في خدمة الاخرين بارك الله بك و بأعضاء هذا المنتدى جزاك الله خيراً

استاذ جمال و الأخت ام عبدالله عذراً لم أر مشاركتكما الا بعد تحميل خاصتي

السلام عليكم و رحمة الله الحل في المرفق 15455 معدل.rar

استاذ احمد/ صباح الخير انت تُعتبر من المتقدمين في هذا المجال / و ما أجمل التواضع ربما كان صاحب العلاقة بحاجة ماسة الى المساعدة و لا وقت لديه للانتظار لذلك ارجو المعذرة

صديقي محمد من أبسط الأمور طبعاً بنوك محمد رزق.rar

صديقي محمد الكود مرفق ارجو ان ينال اعجابك بنوك.rar

بعد اذن الاستاذ عبدالله المجرب اخي سعد حاول ان تجرب هذا الكود acc 1.rar

صديقي ايمن لا حاجة الى الكود في مثل هذه الحالة الحل مرفق عددين من صفحتين.rar

اخي سعد الحل مرفق بواسطة التنسيق الشرطي اذا كان هذا يعجبك acc.rar

ربما يجب ان تضع كلمة السر بين مزدوجين " "

يجب ان تستبدل السطر الأحمر بما يلي sh.Unprotect Password:=myPassword حيث sh هو اسم الشيت و mypassword هي كلمة السر

السلام عليكم / اخي حسّان مرفق ملف عن طلبكم اكتب فيه الأسماء المعادلات تتناسب مع التاريخ كل يوم بيومه عسى ان ينال اعجابكم تنبيه مغادرة.rar