طلب كود ترحيل بشرط ؟

[world liner]

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

اخواني الكرام

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

UAEHELD

تقرير يضم عدد الشحنات المتوقفة ومعلوماتها ، فعند الضغط علي المربع بعلامة صح يتم نقل معلومات الشحنة ورقمها الي الصفحة movement

 

movement

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

 

طلبي هو : اريد ترحيل الشحنات  من صفحة movement الي صفحة moved وعند ترحيلها يتم تلقائيا حذفها من صفحة UAEHELD عن طريق مسح محتوي الخلايا C الي U للاسطر او الشحنات التي حددتها فقط ( بوضعي علامة صح في الخلايا C) . مع كل ترحيل يومي يتم حفظ المعلومات بالترتيب في صفحة moved ، فلايتم حذف او استبدالها بالمعلومات السابقة.

 

ملاحظة : كل شيك بوكس نتيجته في نفس الخلية التي هو بها . (true & False )

 

شكرا لكم جزيلا وارجو ان طلب واضح لكم .

test.rar

تم تعديل ديسمبر 2, 2013 بواسطه world liner

[world liner]

للرفع

[world liner]

للرفع

[أبو حنــــين]

السلام عليكم

جرب المرفق

test_1.rar

[world liner]

عليكم السلام اخي أبو حنين ،

شكرا لك لاكن لم يعمل بما هو مطلوب، الكود لم يقم بترحيل المعلومات المسجلة في صفحة movement  الي صفحة moved ، في صفحة movement هناك معادلات المفترض انها لاتحذف ابدا ، لو رايت الملف المرفق من قبلي في اول مشاركة لوجدت اني عندما احدد علامة صح في صفحة UAEHELD تقوم المعادلات في صفحة movement بجلبها ( أي جلب أي سطر فيه علامة صح في العمود C في صفحة UAEHELD ) ، اريد عند الضغط على الزر في صفحة movement يقوم الكود بترحيل هذه المعلومات الموجود في صفحة movement الي صفحة moved ومن ثم مسح الاسطر التي تم ترحيلها من صفحة UAEHELD ( لان عند مسحها سوف تمسح تلقائيا من صفحة movement ) ، المفترض في كل عملية ترحيل ان يتم إضافة المعلومات الي المعلومات القديمة فلايتم استبدالها او حذف المعلومات القديمة. 

[أبو حنــــين]

السلام عليكم

امسح الكود السابق و اكتب بدله الكود التالي

Sub Hanine()

NN = Sheets("movement").Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To NN
    If Sheets("movement").Cells(x, 1).Value2 = "" Then
    last = Sheets("movement").Cells(x, 1).Row - 1
    Exit For
    End If
    Next
Sheets("movement").Range("A2:D" & last).Copy
N = Sheets("moved").Cells(Rows.Count, "A").End(xlUp).Row + 1

Sheets("moved").Range("A" & N).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
    For y = 1 To Sheets("UAEHeld").Cells(Rows.Count, "b").End(xlUp).Row
    If Sheets("UAEHeld").Cells(y, 2).Text = "complete" Then
    Sheets("UAEHeld").Rows(y).Delete Shift:=xlToLeft
    End If
    Next

End Sub

[world liner]

اخي الكريم

النتيجة رسالة خطا في الكود التالي:

 

Sheets("movement").Range("A2:D" & last).Copy

 

ملاحظة : عند إضافة علامة صح للمربع فان الخلية نفسها ( C) ستتحول الي "true " وليس لها علاقة ب الخلية B  ( complete or incomplete )

، المقصود اني عندما ضع علامة صح فان السطر كاملا سوف ينتقل الي صفحة movement بالمعادلات الموجودة في صفحة movement ، والكود المراد هو ان يتم ترحيل هذا السطر او السطور الي صفحة  moved ومسحها من صفحة UAEHELD، لذا المفترض ان الشرط يكون متصل ب العمود c وليس b

 

 

[world liner]

اخي الكريم

ارجو النظر الي الصورة في الملف المرفق فربما تكون أوضح لايصال فكرة الكود اوالترحيل لمراد عمله.

explain.rar

[world liner]

للرفع

[أبو حنــــين]

السلام عليكم

جرب المرفق

test_3.rar

[world liner]

اخي أبو حنين

شكرا لك ، الكود يعمل المطلوب لاكن لدي ملاحظة واستفسار :

في اخر الكود وبالتحديد :

 

if sheets ("UAEHELD").cells (y,3).text="true
then

 

اريد ان يتم مسح السطر كاملا من الخلية c الي الخلية Z في صفحة UAEHELD  بدلا من ان يقوم بتغير True الي False .

عند تنفيذ هذا الطلب يكون الكود 100 %

 

 

شكرا لك

[أبو حنــــين]

السلام عليكم

غير الكود السابق بهذا

Sub Hanine()

NN = Sheets("movement").Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To NN
    If Sheets("movement").Cells(x, 1).Value2 = "" Then
    last = Sheets("movement").Cells(x, 1).Row - 1
    Exit For
    End If
    Next
If Sheets("movement").Range("A2") = "" Then Exit Sub
Sheets("movement").Range("A2:D" & last).Copy
N = Sheets("moved").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("moved").Range("A" & N).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
    
    For y = 1 To Sheets("UAEHeld").Cells(Rows.Count, "C").End(xlUp).Row
    If Sheets("UAEHeld").Cells(y, 3).Text = "TRUE" Then
    Sheets("UAEHeld").Range("C" & y & ":" & "I" & y) = "FALSE"
    Sheets("UAEHeld").Range("J" & y & ":" & "Z" & y).ClearContents
    End If
    Next

End Sub