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

تمت الإضافة أخي سليم جزيت خيراً على هذا الكود المفيد والرائع تسلم وفي انتظار المزيد يا أبا يزيد

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

بارك الله فيك يا بن الملك يبدو أن درس الأخ حسام بدأت تظهر بوادره جرب الكود المرفق أخي الفاضل ابن الملك ، حيث أنه سيسمح لك بتنفيذ الأمر وإدراج الصفوف مرة واحدة أي صف واحد فقط حتى لو قمت بتكرار تنفيذ الكود ، والحلقة التكرارية معكوسة ولذلك تم استخدام Step -1 Sub InsertRows() Dim I As Long For I = 25 To 1 Step -1 If Cells(I, 5).Value = "t" And Cells(I + 1, 5) <> "" Then Cells(I, 5).Offset(1, 0).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove End If Next End Sub

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

بسم الله ما شاء الله ..شرح في منتهى الجمال والروعة ربنا يبارك فيك يا مستر حسام ومشكور على الساعة الهدية (بس الساعة دي 60 دقيقة ؟ ولا ساعة الحظ متتعوضش) ملحوزة صغيرة : في المثال رقم 7 صحح عندك ..عشان تجيب العمود لازم فيه حاجة كمان تتغير ركز واعرف الخلطة فين : nn = Cells(1, Columns.Count).End(xlToLeft).Column ركز واصحى فيه ناااااس مراقبينك !! تقبل تحياتي

ممكن ترفق ملف بطلبك لأنه مش واضح بالنسبة لي ...

كلمة لا يعمل أخي الفاضل كلمة عامة وليس لها معنى عند التعامل مع الإكسيل حدد نوع الخطأ الذي يظهر عند تنفيذ الكود ...؟ أو ارفق صورة برسالة الخطأ التي تظهر لك وتأكد من أسماء أوراق العمل لديك

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

جرب اضغط على مشاركة المصنف ثم أزل علامة الصح

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

اخي الكريم وجزاكم الله كل خير الحمد لله أن تم بخير حاول أن تبتعد عن دمج الخلايا فهي تسبب مشاكل لا حصر لها عند التعامل مع الأكواد تقبل تحياتي

أخي الحبيب ابن مصر بارك الله فيك دايما سداد ورانا ..ربنا يحميك من كل سوء

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

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

أخي الفاضل إليك الملف المرفق قم بالضغط على Alt + F8 ثم اختر الماكرو المسمى InsertTotal لاحظ أن المجموع العام غير موجود في نهاية الصفحة .. نفذ الكود ولاحظ المجموع العام وراجع النتيجة يرجى عند زيادة صفحات العمل ألا تكون الخلايا الخاصة بالمجموع الفرعي أو المجموع العام مدمجة .. قمت بإلغاء الدمج على الصفحات الموجودة في خلايا المجموع والمجموع العام فقط Book.rar

جرب هذه المعادلة =MID(INFO("directory"),10,LEN(INFO("directory"))-20)

جزاكم الله خيراً أخي الحبيب أبو تراب على هذه المعادلة الرائعة

حل آخر ... اذهب للتبويب Formulas ثم Name Manager ثم اضغط New واكتب في حقل الـ Name اكتب الاسم User وفي حقل الـ Refers To اكتب المعادلة التالية: =GET.WORKSPACE(26) ثم أوك اذهب لأي خلية واكتب بها =User

طيب إحنا في 2015 .. دا أنا مكسوف من نفسي إني لسه بستخدم 2007 أكتر ..!! آن الأوان لنجدد ونحدث

الحمد لله الذي بنعمته تتم الصالحات تقبل تحياتي أخي الكريم

أخي الحبيب المشكلة بملفك حيث أنك قمت بعمل حدود لكل خلايا ورقة العمل ، وهذا خطأ فادح حيث أنه يثقل من التعامل مع الملف من ناحية ويتعارض مع هذا السطر في الكود.. قم بحميل المرفق التالي Extract Data By Code.rar

اطرح طلبك في موضوع مستقل وارفق ملف للتوضيح

إثراءاً للموضوع هذا حل آخر كنت قد جهزته بالأمس بالأكواد Extract Data By Code.rar

ما هو نسخة الأوفيس التي تعملين عليها؟ التبويب Home في أوفيس 2007 فما فوق ..

جرب Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 12 Then Exit Sub If Target.Row <> 3 Then Exit Sub Application.ScreenUpdating = False m = [L3] n = Range("A11").Row o = m + n For i = n To 30 If Cells(i, 1).Row <= o - 1 Then Cells(i, 1).EntireRow.Hidden = False Else Cells(i, 1).EntireRow.Hidden = True End If Next Application.ScreenUpdating = True End Sub