عبدالله المجرب

السلام عليكم جرب هذا التعديل على الملف PAY HOTEL-12.rar

بارك الله فيك ابا ادم كفييت ووفيت سجلني ضمن المتابعين لهذه السلسلة مع اخي ابو عمر

هل مدى الفلترة كبير

من الافضل توضيح المطلوب دفعة واحدة لتوفير الوقت بارك الله فيك اخي ابو حنين

السلام عليكم العنوان كما هو وساقوم بتغييره بعد اذن الاخوة الكرام ولكن للاسف الاخ الفاضل لم يلتزم هنا بالقواعد http://www.officena.net/ib/index.php?showtopic=41724

ممكن ونصف وستجد الكل يتفنى في الاجابة افتح موضوع جديد وضع عنوان مناسب وشرح لما تريد ومرفق

السلام عليكم اليك المرفق وبه الحل في الخلية A1 يتم وضع الصف التالي للترحيل فيرجى عدم التغيير فيها واذا اردت مسح البيانات والبدء من جديد ضع فيها الرقم 5 Copy of PAY HOTEL-1.rar

اخي في السابق كان يتم التنبية وتعديل العنوان على امل الاتزام ولكن لا حياة لمن تنادي لذا من الان وصاعداً سيتم التعامل مع المشاركات المخالفة (على الاقل من قبلي) ما ليم اضافة حل اليها بالاغلاق والحذف

هل قصد ان يتم طباعة صف المورد في كل مرة ام جميع تكراراته في ورقة واحدة

ان شاء الله الامر ممكن ضع مرفق للعمل عليه

السلام عليكم هذا التعديل Sub دور_ثاني() Test_1 = "دور ثان" Test_2 = "لها ور ثانٍ فى" HidMyRow Test_1, Test_2 End Sub Sub الناجحين() Test_1 = "ناجح" Test_2 = "نـاجـــــــحة" HidMyRow Test_1, Test_2 End Sub Sub الغايبين() Test_1 = "غائب" Test_2 = "نـاجـــــــحة" HidMyRow Test_1, Test_2 End Sub Sub HidMyRow(Test_1, Test_2) MyCol = 28 MyCol2 = 10 Application.ScreenUpdating = False Rows.Hidden = False Serial = 0 For MyRow = 10 To 34 ChkMy = Cells(MyRow, MyCol) ChkMyNum = Cells(MyRow, MyCol2) If ChkMy <> Test_1 And ChkMy <> Test_2 Or ChkMyNum = "" Then Rows(MyRow).Hidden = True Else Serial = Serial + 1 Cells(MyRow, 3) = Serial End If Next Application.ScreenUpdating = True End Sub Sub ShowAll() Application.ScreenUpdating = False Rows.Hidden = False Range("B6:B7").ClearContents MyCol2 = 4 For MyRow = 10 To 34 ChkMyNum = Cells(MyRow, MyCol2) If ChkMyNum <> "" Then Cells(MyRow, 3) = MyRow - 5 End If Next Application.ScreenUpdating = True End Sub

فقط في هذا التاريخ ام ابتداء من هذا التاريخ

ادرجها كصورة

السلام عليكم الحمدلله اعتقد ان المحاولة نجحت اليك الحل مضاف اليه زر التعديل من عبد الله الى ابو شرف (1).rar

اليك هذا الموضوع به ما تطلب http://www.officena.net/ib/index.php?showtopic=34859&hl=&fromsearch=1

اخي احمد لا داعي للرفع فالموضوع مثبت (سيحتاج الموضوع الى تنقيح) بالفعل ما افاد به الاستاذ ابو ادم عمل مجدي واكثر نفعاً من رايي

اخي بصراحة نحن بحاجة الى توضيح اكثر في المطلوب (في ملفك)

أحسنت اخي ابو حنين

اخي هاني بصراحة المطلوب غير مفهوم

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

السلام عليكم جرب هذا الكود Sub Abu_Ahmed() Dim cl As Range For Each cl In Sheets("Sheet1").AutoFilter.Range If Not cl.HasFormula = True Then cl = "" Next End Sub

تم التنبيه بسبب مخالفة القواعد

السلام عليكم اولا ً : نرجو لالتزام بقواعد المشاركة (ثاني تنبيه) وعدم تكرار المواضيع ثانياً لا توجد فورم في الملف

اخي ارفق مثال لمشكلتك للعمل المباشر عليه

اليك المرفق بعد التعديل Book100.rar