البحث في الموقع

الساده / أعضاء المنتدى المحترمين السلام عليكم ورحمه الله وبركاته أقدم لكم طريقة مبسطة لشرح آلية الترحيل بالكود وقد إستخدمت كود مبسط لكى يكون سهل التعديل عليه حسب ما ترغبون وهذا الكود للترحيل مع مسح البيانات المدخله مع آلية الترقيم التلقائى الشرح في المثال المرفق ستجد ورقتا عمل " Invoice " " List" وسيتم إدخال البيانات في الورقه " Invoice " ثم بعد الإنتهاء نضغط على الزر لتنتقل في أماكن محدده بورقة العمل " List " .. * تعالوا نرى الكود كود: Sub MoveData() Dim EndRow As Long If Sheets("Invoice").Range("B3").Value = "" Or Sheets("Invoice").Range("D3").Value = "" Or Sheets("Invoice").Range("a5").Value = "" Or Sheets("Invoice").Range("D6").Value = "" Or Sheets("Invoice").Range("B8").Value = "" Or Sheets("Invoice").Range("D8").Value = "" Then MsgBox prompt:="تأكد من إدخال كافة البيانات", Title:="خطأ" Else EndRow = Sheets("List").Range("A1").CurrentRegion.Rows.Count Sheets("List").Cells(EndRow + 1, 1).Value = EndRow Sheets("List").Cells(EndRow + 1, 2).Value = Sheets("Invoice").Cells(3, 2).Value Sheets("List").Cells(EndRow + 1, 3).Value = Sheets("Invoice").Cells(3, 4).Value Sheets("List").Cells(EndRow + 1, 4).Value = Sheets("Invoice").Cells(5, 1).Value Sheets("List").Cells(EndRow + 1, 5).Value = Sheets("Invoice").Cells(6, 4).Value Sheets("List").Cells(EndRow + 1, 6).Value = Sheets("Invoice").Cells(8, 2).Value Sheets("List").Cells(EndRow + 1, 7).Value = Sheets("Invoice").Cells(8, 4).Value Sheets("Invoice").Range("B3,D3,A5:D5,D6,B8,D8").ClearContents MsgBox prompt:="تم ترحيل البيانات بنجاح", Title:="رسالة تأكيد" End If End Sub * الكود السابق هو الخاص بعملية الترحيل من الورقه " Invoice " الي الورقه " List " ولكن ماذا يعني الكود وكيف نعدل فيه حسب الرغبه ؟ * في الكود التالي وضعنا شرط على الخلايا التي يتم إدخال البيانات بها بالورقه "Invoice" بحيث تظهر رساله تفيد بأنه يجب التأكد من إدخال كافة البيانات مع العلم أنه يمكن الأستغناء عن بعض الخلايا أو كلها بحذف الشرط أو جزأ منه كود: If Sheets("Invoice").Range("B3").Value = "" Or Sheets("Invoice").Range("D3").Value = "" Or Sheets("Invoice").Range("a5").Value = "" Or Sheets("Invoice").Range("D6").Value = "" Or Sheets("Invoice").Range("B8").Value = "" Or Sheets("Invoice").Range("D8").Value = "" Then MsgBox prompt:="تأكد من إدخال كافة البيانات", Title:="خطأ" * وهنا سيبدأ البحث عن أول صف فارغ لنقل البيانات أليه مع الترقيم في العمود A كود: EndRow = Sheets("List").Range("A1").CurrentRegion.Rows.Count * هنا سيقوم بنقل البيانات المدخله في الورقه "Invoice" في الخليه الموجوده في الصف الثالث - العمود الثاني الي الورقه " List " في الخليه الموجوده في العمود الثاني - الصف الأول كود: Sheets("List").Cells(EndRow + 1, 2).Value = Sheets("Invoice").Cells(3, 2).Value * وهكذا ينطبق الكود السابق على باقي الخلايا المدخل بها البيانات الي أن نصل الي * هذا الكود يقوم بمسح البيانات المدخله بالورقه " Invoice" بعد نقلها للورقه " List " كود: Sheets("Invoice").Range("B3,D3,A5:D5,D6,B8,D8").ClearContents * بقي كود يظهر رسالة تأكيد بإنتهاء العمليه بنجاح كود: MsgBox prompt:="تم ترحيل البيانات بنجاح", Title:="رسالة تأكيد" أسأل الله العلى القدير أن أكون وفقت فى الشرح ومرفق نموذج للتطبيق العملى وتقبلوا منى وافر الإحترام والتقدير شرح الترحيل.rar