aburajai قام بنشر ديسمبر 16, 2013 قام بنشر ديسمبر 16, 2013 اخواني الاحباء ارجو المساعدة في ترحيل بيانات من الصفحة 1 من جدول الى جدول في صفحة2 و صفحة 3 مع الشكر الجزيل المثال داخل الملف المرفق aburaji9.rar 1
أبو حنــــين قام بنشر ديسمبر 16, 2013 قام بنشر ديسمبر 16, 2013 السلام عليكم انسخ هذا الكود في الصفحة رقم 1 Private Sub Worksheet_Change(ByVal Target As Range) Last_Row = ورقة2.Cells(Rows.Count, "D").End(xlUp).Row + 1 LastRow = ورقة3.Cells(Rows.Count, "D").End(xlUp).Row + 1 If Not IsEmpty(Target) Then If Target.Column = 3 Then ورقة2.Cells(Last_Row, 4) = Target.Value Else If Target.Column = 4 Then ورقة3.Cells(LastRow, 4) = Target.Value End If End If End If End Sub
aburajai قام بنشر ديسمبر 16, 2013 الكاتب قام بنشر ديسمبر 16, 2013 اخي ابو حنين بارك الله فيك هذا الكود يرحل اخر خليه في السطر انا اريد يرحل كامل الشطر يعني اربع خانات شكرا لتعاونك
أبو حنــــين قام بنشر ديسمبر 16, 2013 قام بنشر ديسمبر 16, 2013 استعمل هذه الكود Private Sub Worksheet_Change(ByVal Target As Range) Last_Row = ورقة2.Cells(Rows.Count, "D").End(xlUp).Row + 1 LastRow = ورقة3.Cells(Rows.Count, "D").End(xlUp).Row + 1 If Not IsEmpty(Target) Then If Target.Column = 3 Then Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 3)).Copy ورقة2.Cells(Last_Row, 1) Else If Target.Column = 4 Then Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 4)).Copy ورقة3.Cells(LastRow, 1) End If End If End If End Sub
aburajai قام بنشر ديسمبر 17, 2013 الكاتب قام بنشر ديسمبر 17, 2013 (معدل) استعمل هذه الكود Private Sub Worksheet_Change(ByVal Target As Range) Last_Row = ورقة2.Cells(Rows.Count, "D").End(xlUp).Row + 1 LastRow = ورقة3.Cells(Rows.Count, "D").End(xlUp).Row + 1 If Not IsEmpty(Target) Then If Target.Column = 3 Then Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 3)).Copy ورقة2.Cells(Last_Row, 1) Else If Target.Column = 4 Then Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 4)).Copy ورقة3.Cells(LastRow, 1) End If End If End If End Sub السلام عليكم ورحمة الله اخي ابو حنين وضعت الكود الجديد ولم يعمل اخي حبذا لو غلبتك قليلا فسامحني ان تقوم بوضعه في الملف المرفق والتاكد منه وارفاق الملف بعد التعديل فلعل الخطا يكون مني شاكرا تعاونك وفي ميزان حسناتك ان شاء الله تم تعديل ديسمبر 17, 2013 بواسطه aburajai
أبو حنــــين قام بنشر ديسمبر 17, 2013 قام بنشر ديسمبر 17, 2013 السلام عليكم لا يوجد مرفق الخطأ في تسمية الاوراق Private Sub Worksheet_Change(ByVal Target As Range) Last_Row = sheet2.Cells(Rows.Count, "D").End(xlUp).Row + 1 LastRow = sheet3.Cells(Rows.Count, "D").End(xlUp).Row + 1 If Not IsEmpty(Target) Then If Target.Column = 3 Then Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 3)).Copy sheet2.Cells(Last_Row, 1) Else If Target.Column = 4 Then Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 4)).Copy sheet3.Cells(LastRow, 1) End If End If End If End Sub
aburajai قام بنشر ديسمبر 17, 2013 الكاتب قام بنشر ديسمبر 17, 2013 (معدل) اخي ابو حنين ملف الاكسل مرفق في المشاركة الاولى بارك الله فيك لم يعمل الكود عندي للتذكير : انا اعمل على اكسل 2003 تم تعديل ديسمبر 17, 2013 بواسطه aburajai
aburajai قام بنشر ديسمبر 17, 2013 الكاتب قام بنشر ديسمبر 17, 2013 بارك الله فيك ابو حنين وجزاك الله خيرا هناك مشكلة ظهرت عندي وهي عندما اقوم باستعما خاصية الالصاق في سطر الصفحة الاولى لا يقوم الكود بترحيل البيانات الى الصفحة2 و 3 اما اذا قمت بالكتابة في كل خلية على حدة يقوم الكود بالترحيل فهل من الممكن حل هذه المشكلة جزاك الله خيرا
عطاء الله قام بنشر ديسمبر 17, 2013 قام بنشر ديسمبر 17, 2013 السلام عليكم أخي أبو رجاء بعد إذن الأخ أبو حنين هذه طريقة بواسطة المعادلات صحيحة 100/100حسب فهمي لك ataa.rar 1
aburajai قام بنشر ديسمبر 17, 2013 الكاتب قام بنشر ديسمبر 17, 2013 السلام عليكم اخي عطاء الملف لا يفتح فيه مشكلةارجو عمل المعادلات على ملف جديد 2003 اكسل مع الشكر
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.