ترحيل البيانات بواسطة الأكسيل

شاهدنا في الموضوع التالي http://www.hiarab.net/article6308.html برنامج لمتابعة المراجعين . وأعتقد أن الكثيرون قد أندهشوا لإمكانيات الأكسيل في القدره على تنفيذ العديد من رغباتنا .

* إذاً كيف تتم عملية ترحيل البيانات ؟ في المثال المرفق ستجد ورقتا عمل " 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:="رسالة تأكيد"

* أرجو أن تكون الفكره قد أتضحت

الرابط هنا

http://www.hiarab.net/attachments/college69/2716d1123569091