(تمت الإجابة) مساعدة فى ترحيل البيانات محددة

[saad abed]

اخوانى الاعضاء

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

اطلب منكم مساعدتى فى ترحيل البياناتمن صفة ترحيل الى صفحة مرتبات والشرح داخل الملف

اشكركم

سعد عابد

Book1.rar

[عبدالله المجرب]

السلام عليكم

اخي سعد تفضل المرفق بعد التعديل عليه

Sub OFFICNA()

Set a = Sheets("الترحيل")

Set b = Sheets("المرتبات")

LR = b.Range("b" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False

For Each cl In b.Range("B4:B" & LR)

If a.Range("C8").Value = cl.Value Then

b.Select

cl.Select

Cells(cl.Row, 3).Value = a.Range("C9")

Cells(cl.Row, 4).Value = a.Range("C10")

Cells(cl.Row, 5).Value = a.Range("C11")

Cells(cl.Row, 6).Value = a.Range("C12")

Cells(cl.Row, 8).Value = a.Range("E7")

Cells(cl.Row, 10).Value = a.Range("E8")

Cells(cl.Row, 12).Value = a.Range("E9")

Cells(cl.Row, 14).Value = a.Range("E10")

Cells(cl.Row, 15).Value = a.Range("E11")

Cells(cl.Row, 16).Value = a.Range("E12")

End If

Next cl

End Sub

عبدالله المجرب.rar

[saad abed]

اخى عبدالله المجرب

بارك الله فيك وجزاك الله خيرا

اسال الله ان يديم عليك الصحة والعافية ويسدل ستره عليك فى الدنيا والاخرة

اخى عبدالله

هذا هو المطلوب فعلا ولكن ملحوطة واحده فقط

المخطط انى امسح كل البيانات واعيد ترحيلها لان العمالة احيانا متغييرة

كنت اطلب ترحيل غير مشروط برقم العامل ولكننى من الممكن استفيد من الشرط

هل من الممكن اذا لم يجد الرقم يرحل ايضا بمعنى عامل جديد

عذرا اذا لم استطيع توصيل المعلومة من اول مره اخى

اخوك سعد عابد

[هشام شلبى]

السلام عليكم

=======

بارك الله فيك ابو احمد

الاخ سعد عابد شاهد المرفق ومازال تحت التجربة

HH.rar

[هشام شلبى]

السلام عليكم

========

لمخطط انى امسح كل البيانات واعيد ترحيلها لان العمالة احيانا متغييرة

كنت اطلب ترحيل غير مشروط برقم العامل ولكننى من الممكن استفيد من الشرط

هل من الممكن اذا لم يجد الرقم يرحل ايضا بمعنى عامل جديد

تم التعديل على الكود ليقوم بالترحيل فى حالة عدم وجود رقم العامل وفى حالة مسح كل البيانات

HH1.rar

[saad abed]

اخواتى فى الله هشام شلبى وعبدالله المجرب

الشكر كل الشكر اخجلتمونى بسرعة الرد وسعة الصدر

اسال الله ان يبارك لكما وان يجمعنى بكما تحت ظله يوم لا ظل الا ظله اللهم امين

جزاكم الله خيرا وشكرا لكم لا تفى الكلمات بسرورى بمروركم وسرعة ردكم

كانت هناك ملحوظة استاذ هشام وتم التعديل لان الكود واضح ما شاء الله

واخى عبدالله لا اريد ان اتعبك اكثر من كده شكرا لك

اخوكم سعد عابد

[saad abed]

اخى هشام شلبى

استخدمت كودك فى الترحيل واستخدمت كود اخى عبدالله فى التعديل

ولكن ظهرت مشكلة صغيرة اسالك لماذا

بعد ان اضفت المعادلات فى صفحة المرتبات فى الاعمدة التى لا يرحل اليها

ظهر بعدها الكود يرحل الى بداية ظهور المعادلات ولتكن مثلا a302هنا تكون بداية الترحيل من a302:a5 فارغ

شكرا لك

تحياتى

Sub MoveValue2()

Dim EndRow As Long

If ورقة1.Range("c6").Value = "" Then

MsgBox prompt:="تأكد من إدخال كافة البيانات", Title:="خطأ"

Exit Sub

End If

'------------------------------------------------------------------

If Cells(2, 6) = "H" Then

EndRow = ورقة2.Range("A1").CurrentRegion.Rows.Count

ورقة2.Cells(EndRow + 1, 1).Value = EndRow

ورقة2.Cells(EndRow + 1, 2).Value = ورقة1.Cells(8, 3).Value

ورقة2.Cells(EndRow + 1, 3).Value = ورقة1.Cells(9, 3).Value

ورقة2.Cells(EndRow + 1, 4).Value = ورقة1.Cells(10, 3).Value

ورقة2.Cells(EndRow + 1, 5).Value = ورقة1.Cells(11, 3).Value

ورقة2.Cells(EndRow + 1, 6).Value = ورقة1.Cells(12, 3).Value

ورقة2.Cells(EndRow + 1, 7).Value = ورقة1.Cells(2, 1).Value

ورقة2.Cells(EndRow + 1, 8).Value = ورقة1.Cells(7, 5).Value

ورقة2.Cells(EndRow + 1, 10).Value = ورقة1.Cells(8, 5).Value

ورقة2.Cells(EndRow + 1, 12).Value = ورقة1.Cells(9, 5).Value

ورقة2.Cells(EndRow + 1, 14).Value = ورقة1.Cells(10, 5).Value

ورقة2.Cells(EndRow + 1, 15).Value = ورقة1.Cells(11, 5).Value

ورقة2.Cells(EndRow + 1, 16).Value = ورقة1.Cells(12, 5).Value

MsgBox prompt:="تم ترحيل البيانات بنجاح", Title:="رسالة تأكيد"

'------------------------------------------------------------------

Else

EndRow = ورقة2.Range("A1").CurrentRegion.Rows.Count

ورقة2.Cells(EndRow + 1, 1).Value = EndRow

ورقة2.Cells(EndRow + 1, 3).Value = ورقة1.Cells(6, 3).Value

ورقة2.Cells(EndRow + 1, 5).Value = ورقة1.Cells(11, 3).Value

ورقة2.Cells(EndRow + 1, 7).Value = ورقة1.Cells(2, 1).Value

MsgBox prompt:="تم ترحيل البيانات بنجاح", Title:="رسالة تأكيد"

End If

End Sub

[عبدالله المجرب]

اخي سعد

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

ولكن لكون بالامي قمت بعمل الملف ارفقه لك للفائدة

المرفق تم تعديل شرط الترحيل

عند وجود رقم العامل مسبقاً سيتم التعديل

عند عدم وجود العامل (عامل جديد) سيتم ادراجه في اخر الجدول بعد ان يتم تنبيهك لذلك

جرب واي شيء غير مفهوم في الكود انا في الخدمة

عبدالله المجرب.rar

[saad abed]

استاذى عبدالله المجرب

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

عمل جميل جدا هذا ما اطلب بل زاد عن طلبى

جزاك الله خيرا وبارك فيك

لا تفى الكلمات بشكرك لانى اعلم مدى المجهود المبذول

تحياتى لك

سعد عابد

[ياسر الحافظ]

الاخ / الاستاذ " ابو احمد " عبد الله المجرب

الاخ / الاستاذ المشرف هشــــــــــــــــــــام

كل الشكر للجهود المبذولة ....... وفقكم الله

تحياتي لك اخي العزيز ســــــــــــعد عابد

ابو الحارث