بحث وترحيل

[توكل]

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

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

 

لدي ملف متابعة الإرساليات فيدكس أريد البحث عن قيمة معينة وهي رقم الإرسالية في الخالية G1 فإذا وجد الرقم يتم ترحيل البينات للصفحة Post مع حذف السطر مشكورين>

فيدكس-09.rar

[الصـقر]

تفضل اخى الكريم هل هذا ما تقصده

تقبل تحياتى 

فيدكس-09.zip

[توكل]

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

[الصـقر]

اخى الكريم

استبدل الكود بالكود التالى

Sub Al_saqer()
a = Application.WorksheetFunction.CountIf(Sheet1.Range("b2:b" & Cells(Rows.Count, 2).End(xlUp).Row), Range("G1"))
If a < 1 Then: MsgBox "عفوا: الرقم غير موجود", , "توكل": Exit Sub
b = Application.WorksheetFunction.Match(Range("G1"), Sheet1.Range("b1:b" & Cells(Rows.Count, 2).End(xlUp).Row), 0)
Rows(b).Copy Destination:=Sheet2.Range("a2")
Rows(b).Delete Shift:=xlUp
MsgBox " تمت عملية الترحيل بنجاح", , "توكل"
End Sub

شاهد المرفق

تقبل تحياتى

فيدكس-09.zip

تم تعديل أبريل 13, 2016 بواسطه الصـقر

[توكل]

جزاك الله خيراً هو المطلوب

أمر بسط أخي الصقر :

في صفحة Post  أريد الإحتفاظ بالبيانات يعني الكود يعود هنا بلصق البيانات الجديدة فوق البيانات القديمة وأنا أريد أن يلصق البيانات الجديدة تحت القديمة مع الشكر الجزيل

[الصـقر]

تفضل اخى الكريم

جرب هذا الكود

Sub Al_saqer()
a = Application.WorksheetFunction.CountIf(Sheet1.Range("b2:b" & Cells(Rows.Count, 2).End(xlUp).Row), Range("G1"))
If a < 1 Then: MsgBox "عفوا: الرقم غير موجود", , "توكل": Exit Sub
b = Application.WorksheetFunction.Match(Range("G1"), Sheet1.Range("b1:b" & Cells(Rows.Count, 2).End(xlUp).Row), 0)
lr = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(b).Copy Destination:=Sheet2.Cells(lr, 1)
Rows(b).Delete Shift:=xlUp
MsgBox " تمت عملية الترحيل بنجاح", , "توكل"
End Sub

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

تقبل تحياتى

[توكل]

جزاك الله خيراً وأحسن إليك