saad abed قام بنشر سبتمبر 16, 2011 مشاركة قام بنشر سبتمبر 16, 2011 اخوانى الاعضاء بعد السلام عليك ورحمة الله وبركاته اطلب منكم مساعدتى فى ترحيل البياناتمن صفة ترحيل الى صفحة مرتبات والشرح داخل الملف اشكركم سعد عابد Book1.rar رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر سبتمبر 16, 2011 مشاركة قام بنشر سبتمبر 16, 2011 السلام عليكم اخي سعد تفضل المرفق بعد التعديل عليه 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 رابط هذا التعليق شارك More sharing options...
saad abed قام بنشر سبتمبر 16, 2011 الكاتب مشاركة قام بنشر سبتمبر 16, 2011 اخى عبدالله المجرب بارك الله فيك وجزاك الله خيرا اسال الله ان يديم عليك الصحة والعافية ويسدل ستره عليك فى الدنيا والاخرة اخى عبدالله هذا هو المطلوب فعلا ولكن ملحوطة واحده فقط المخطط انى امسح كل البيانات واعيد ترحيلها لان العمالة احيانا متغييرة كنت اطلب ترحيل غير مشروط برقم العامل ولكننى من الممكن استفيد من الشرط هل من الممكن اذا لم يجد الرقم يرحل ايضا بمعنى عامل جديد عذرا اذا لم استطيع توصيل المعلومة من اول مره اخى اخوك سعد عابد رابط هذا التعليق شارك More sharing options...
هشام شلبى قام بنشر سبتمبر 16, 2011 مشاركة قام بنشر سبتمبر 16, 2011 السلام عليكم ======= بارك الله فيك ابو احمد الاخ سعد عابد شاهد المرفق ومازال تحت التجربة HH.rar رابط هذا التعليق شارك More sharing options...
هشام شلبى قام بنشر سبتمبر 16, 2011 مشاركة قام بنشر سبتمبر 16, 2011 السلام عليكم ======== لمخطط انى امسح كل البيانات واعيد ترحيلها لان العمالة احيانا متغييرة كنت اطلب ترحيل غير مشروط برقم العامل ولكننى من الممكن استفيد من الشرط هل من الممكن اذا لم يجد الرقم يرحل ايضا بمعنى عامل جديد تم التعديل على الكود ليقوم بالترحيل فى حالة عدم وجود رقم العامل وفى حالة مسح كل البيانات HH1.rar رابط هذا التعليق شارك More sharing options...
saad abed قام بنشر سبتمبر 16, 2011 الكاتب مشاركة قام بنشر سبتمبر 16, 2011 اخواتى فى الله هشام شلبى وعبدالله المجرب الشكر كل الشكر اخجلتمونى بسرعة الرد وسعة الصدر اسال الله ان يبارك لكما وان يجمعنى بكما تحت ظله يوم لا ظل الا ظله اللهم امين جزاكم الله خيرا وشكرا لكم لا تفى الكلمات بسرورى بمروركم وسرعة ردكم كانت هناك ملحوظة استاذ هشام وتم التعديل لان الكود واضح ما شاء الله واخى عبدالله لا اريد ان اتعبك اكثر من كده شكرا لك اخوكم سعد عابد رابط هذا التعليق شارك More sharing options...
saad abed قام بنشر سبتمبر 16, 2011 الكاتب مشاركة قام بنشر سبتمبر 16, 2011 اخى هشام شلبى استخدمت كودك فى الترحيل واستخدمت كود اخى عبدالله فى التعديل ولكن ظهرت مشكلة صغيرة اسالك لماذا بعد ان اضفت المعادلات فى صفحة المرتبات فى الاعمدة التى لا يرحل اليها ظهر بعدها الكود يرحل الى بداية ظهور المعادلات ولتكن مثلا 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 رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر سبتمبر 17, 2011 مشاركة قام بنشر سبتمبر 17, 2011 اخي سعد قد لا اكون اطلعت على ملف الاستاذ هشام قبل ارفاق هذه المشاركة ولكني على ثقة بان الملف فيه عمل ابداعي ولكن لكون بالامي قمت بعمل الملف ارفقه لك للفائدة المرفق تم تعديل شرط الترحيل عند وجود رقم العامل مسبقاً سيتم التعديل عند عدم وجود العامل (عامل جديد) سيتم ادراجه في اخر الجدول بعد ان يتم تنبيهك لذلك جرب واي شيء غير مفهوم في الكود انا في الخدمة عبدالله المجرب.rar رابط هذا التعليق شارك More sharing options...
saad abed قام بنشر سبتمبر 17, 2011 الكاتب مشاركة قام بنشر سبتمبر 17, 2011 استاذى عبدالله المجرب السلام عليكم ورحمة الله وبركاته عمل جميل جدا هذا ما اطلب بل زاد عن طلبى جزاك الله خيرا وبارك فيك لا تفى الكلمات بشكرك لانى اعلم مدى المجهود المبذول تحياتى لك سعد عابد رابط هذا التعليق شارك More sharing options...
ياسر الحافظ قام بنشر سبتمبر 17, 2011 مشاركة قام بنشر سبتمبر 17, 2011 الاخ / الاستاذ " ابو احمد " عبد الله المجرب الاخ / الاستاذ المشرف هشــــــــــــــــــــام كل الشكر للجهود المبذولة ....... وفقكم الله تحياتي لك اخي العزيز ســــــــــــعد عابد ابو الحارث رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.