حذف الصف وترحيله الى شيت اخر عند اكتمال الشرط

[الوليد زين العابدين]

السلام عليكم ورحمة الله وبركاته

الاساتذه الاعزاء 

في المرفق ملف اكسل ولي رجاء بمساعدتي فيه

المطلوب في الخليه (N) وهي نسبة الانجاز عندما تصبح نسبة الانجاز 100% يتم حذف الصف كامل وترحيله الى شيت البنود المنهية والحال 

نفسه لباقي الصفوف بشرط ان توضع متتاليه في شيت البنود المنتهيه بنفس التنسيق

وفي الخلية (L) وهي خليه لاظهار عدد الايام ناتج طرح تاريخ من تاريخ وفيها المعادلة لكن عند وضع تاريخ البداية وعدم وضع تاريخ النهاية

يظهر الرمز التالي(!NUM#) وانا اريد ان تظهر الخلية فارغة في حال لم يوضع تاريخ النهاية

وتقبلوا مني فائق الاحترام والتقدير 

‫البرنامج الزمني للأعمال المتبقية01.rar

[الوليد زين العابدين]

للرفع واذا كان امر غير مفهوم بطلبي ارجو ترك ملاحظلاتكم

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

أخي الكريم

بالنسبة للخطأ في المعادلة في الخلية L6 قم باستخدام المعادلة بالشكل التالي

=IFERROR(IF(DAY(K6)>=DAY(J6),DAY(K6)-DAY(J6),DAY(K6)+DAY(EOMONTH(K6,-1))-DAY(J6)),"")

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

[الوليد زين العابدين]

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

‫البرنامج الزمني للأعمال المتبقية01.rar

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

الأخ الكريم الوليد زين العابدين

إليك الكود التالي عله يفي بالغرض

Sub CutRow()
    Dim WS As Worksheet, SH As Worksheet, LR As Long, I As Long
    Dim Cell As Range

    Set WS = Sheets(" الخطة النظريةو التنفيذ الفعلي"): Set SH = Sheets("البنود المنتهية")
        
    Application.ScreenUpdating = False
        For Each Cell In WS.Range("N5:N" & WS.Cells(Rows.Count, 1).End(xlUp).Row)
            If Cell.Value >= 1 Then
                LR = IIf(SH.Cells(Rows.Count, 1).End(xlUp).Row <= 4, 4, SH.Cells(Rows.Count, 1).End(xlUp).Row + 1)
                Cell.EntireRow.Copy SH.Range("A" & LR)
            End If
        Next Cell
        
        For I = WS.Cells(Rows.Count, 1).End(xlUp).Row To 5 Step -1
            If Cells(I, "N").Value >= 1 Then
                Cells(I, "N").EntireRow.Delete
            End If
      Next I
        
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

لا تنسى أن تحدد أفضل إجابة كما لا تنسى أن تضغط أعجبني هذا إذا أعجبك الحل وأدى الغرض

تقبل تحياتي

 

 

Cut Cell Entire Row To Another Sheet.rar

[الوليد زين العابدين]

السلام عليكم ورحمة الله وبركاته

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

وتقبل مني فائق احترامي استاذ ياسر

تجربة الكود في هذا الملف.rar

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

المشكلة في دمج الخلايا في الصفوف الأولى ولتفادي هذا الأمر قم بالتعديل بحيث يكون الاعتماد على العمود السادس حيث أن آخر خلية غير مدمجة فيه

غير السطر التالي فقط في الكود

LR = IIf(SH.Cells(Rows.Count, 6).End(xlUp).Row <= 3, 4, SH.Cells(Rows.Count, 6).End(xlUp).Row + 1)

 

[الوليد زين العابدين]

السلام عليكم 

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

تجربة الكود في هذا الملف.rar

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

يبدو أنك عدلت في الكود في مكان ما فأدى للخطأ .. لا يسعني الوقت لكي أدقق فيما فعلت ...

قمت بنسخ الكود الأول وعدلت السطر كما أخبرتك ويعمل الملف بشكل جيد الآن

 

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

Test This.rar

[الوليد زين العابدين]

اخ ياسر اسف  اذا كنت اخذت من وقتك  لكن بنفس الملف المرسل من حظرتك الكود يقوم بالترحيل لكنه لا يقبل الا صفين في شيت البنود المنتهيه و في حال قمت بترحيل ثاني لاي عدد من الصفوف يظهر اخر صف من الصفوف المرحلة الاخيرة ويبقي صف من الصفوف المرحلة سابقا اعتذر مرة اخره على اخذي من وقتك 

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

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

راعي أن موضوع دمج الخلايا يسبب المشاكل مع الاكواد

عموماً جرب هذا الكود .. ولا تنسى أن تحدد أفضل إجابة

Sub CutRow()
    Dim WS As Worksheet, SH As Worksheet, LR As Long, I As Long
    Dim Cell As Range

    Set WS = Sheets(" الخطة النظريةو التنفيذ الفعلي"): Set SH = Sheets("البنود المنتهية")
        
    Application.ScreenUpdating = False
        For Each Cell In WS.Range("N5:N" & WS.Cells(Rows.Count, 1).End(xlUp).Row)
            If Cell.Value >= 1 Then
                LR = IIf(SH.Cells(Rows.Count, 1).End(xlUp).Row <= 3, 4, SH.Cells(Rows.Count, 1).End(xlUp).Row + 1)
                Cell.EntireRow.Copy SH.Range("A" & LR)
            End If
        Next Cell
        
        For I = WS.Cells(Rows.Count, 1).End(xlUp).Row To 5 Step -1
            If Cells(I, "N").Value >= 1 Then
                Cells(I, "N").EntireRow.Delete
            End If
      Next I
        
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[الوليد زين العابدين]

الف شكر اخي ياسر مبدع بارك الله فيك