شمس الثورة قام بنشر يوليو 22, 2011 قام بنشر يوليو 22, 2011 السلام عليكم ابحث عن كود عن طريقه تنقل البيانات فقط من الشيت الى كشف المنقولين دون حذف اى صف من ورقة الشيت بمعنى كود ينقل البيانات فقط وينقل البيانات كاملة وجعلكم الله فى عون المحتاج فعند كتاية منقول يتم نقل البيانات فقط الى صفحة المنقول ويترك الصف فارغ المنقول.rar 1
عبد الفتاح كيرة قام بنشر يوليو 23, 2011 قام بنشر يوليو 23, 2011 كود Sub Macro4() ' ' Macro4 ماكرو by kemas ' Dim mycl As Range Dim myrng As Range ' Application.ScreenUpdating = False Range("newrng").ClearContents Range("I2").Select Sheets("الشيت").Range("A1:N41").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("منقول!Criteria"), CopyToRange:=Range("A7:N7"), _ Unique:=False ActiveWindow.LargeScroll ToRight:=1 Range("A7").Select Set myrng = Sheets("الشيت").Range("n1:n41") For Each mycl In myrng If mycl = "منقول" Then mycl.EntireRow.ClearContents End If Next mycl Sheets("منقول").Select Application.ScreenUpdating = True End Sub مرفق المنقول-kemas.rar
شمس الثورة قام بنشر يوليو 23, 2011 الكاتب قام بنشر يوليو 23, 2011 السلام عليكم الخىkemas عمل رائع ولكن بعد ترحيل البانات عند الضغط على زر الترحيل يتم حذف البيانات التى كانت موجوده فانا اريد عندما لكتب منقول فى الشيت واضغط زر الترحيل يتم نقل البيانات مثلما فعلت انت ولكن لا يمسح البانات التى رحلت مسبقا فانا عندما رحلت البيانات ثم ضغط مره اخرى على الزر قام بمسح البيانات ارجو مساعدتك
عبدالله المجرب قام بنشر يوليو 23, 2011 قام بنشر يوليو 23, 2011 لكتب منقول فى الشيت واضغط زر الترحيل يتم نقل البيانات مثلما فعلت انت ولكن لا يمسح البانات التى رحلت مسبقا فانا عندما رحلت البيانات ثم ضغط مره اخرى على الزر قام بمسح البيانات ارجو مساعدتك اخي شمس تفضل المرفق بعد التعديل المنقول-kemas.rar
ياسر الحافظ قام بنشر يوليو 23, 2011 قام بنشر يوليو 23, 2011 الاخوة / الاساتذة : كيماس " ابو عمر " - عبد الله المجرب " ابو احمد " جزاكم الله كل الخير على هذه الاكواد الرائعة احببت ان اشارك معكم في هذا الموضوع ( من باب المشاركة والتنوع ) كود يقوم بالترحيل ويجمع المنقولين في الورقة ( منقول ) ولكنه يحذف الاصل من الورقة ( الشيت ) عسى ان ينتفع به اخونا العزيز " شمس الثورة " وفقكم الله ياسر الحافظ تجميع المنقولين مع حذف الاصل.rar
يحيى حسين قام بنشر يوليو 23, 2011 قام بنشر يوليو 23, 2011 السلام عليكم و رحمة الله على نفس ملف الأخ عبدالله المجرب جرب الكود التالي Sub Test() Dim wsF As Worksheet, wsT As Worksheet Set wsF = Sheets("الشيت") Set wsT = Sheets("منقول") With wsF.Range("a1").CurrentRegion .AutoFilter Field:=14, Criteria1:=wsT.Range("b2").Value .Copy wsT.Range("a7") .AutoFilter End With End Sub
MAHMOUD ALI YOUSSEF قام بنشر يوليو 23, 2011 قام بنشر يوليو 23, 2011 (معدل) السلام عليكم تحية خاصة لكل من الاستاذة الكبار يحي حسين ياسر الحافظ ابو احمد كيماس مع حفظ الالقاب علي مجهوداتهم الرائعة التي استفدت منها كثرا وشكرا تم تعديل يوليو 23, 2011 بواسطه MAHMOUDFOXMAM
شمس الثورة قام بنشر يوليو 23, 2011 الكاتب قام بنشر يوليو 23, 2011 السلام عليكم تحية خاصة لكل من الاستاذة الكبار يحي حسين ياسر الحافظ ابو احمد كيماس ولكن طلبى لم يوضح انا اريد ترحيل البيانات فقط من ورقة شيت الى ورقة منقول دون ان يؤثر على تنسيق زرقة الشيت فكود اخى كيماس جيد وهو المطلوب ولكن عند الضغط على الزر مرة اخرى يمسح البانات التى فى ورقة منقول وكود اخى عبدالله المجرب جميل جدا ولكن لم يتم مسح البيانات المرحلة من ورقة الشيت فظلت كما هى فى ورقة الشيت فارجو التعديل وجزاكم الله خيرا
الحسامي قام بنشر يوليو 23, 2011 قام بنشر يوليو 23, 2011 السلام عليكم بارك الله فيكم اخوتي في الله احببت ان اشارك معكم في هذا الموضوع ( من باب المشاركة والتنوع ) Dim c As Range For Each c In Sheet1.Range("case") If c.Value = "منقول" Then Z = Z + 1 lstrow = Sheet4.Range("b20000").End(xlUp).Row + 1 Sheet4.Range(Sheet4.Cells(lstrow, "b"), Sheet4.Cells(lstrow, "ag")) = _ Sheet1.Range(Sheet1.Cells(c.Row, "b"), Sheet1.Cells(c.Row, "ag")).Value Sheet1.Range(Sheet1.Cells(c.Row, "b"), Sheet1.Cells(c.Row, "ag")) = Empty Sheet4.Cells(lstrow, "a") = Z: End If Next c المنقول.rar
شمس الثورة قام بنشر يوليو 23, 2011 الكاتب قام بنشر يوليو 23, 2011 مبدع استاذنا الحسامى ولى بعض الاسئلة هل يمكن شرح مبسط لهذا الكود ثانيا اذا احببت تغير المدى الذى تنقل منه البيانات بمعنى مثلا لا يتم نقل المسلسل مثلا فماذا اغير فى الكود
الحسامي قام بنشر يوليو 23, 2011 قام بنشر يوليو 23, 2011 السلام عليكم مدى الكود( عموديا) هنا متغير اي مهما كانت طول القائمة سيتم حسابها فقد تم استخدام نطاق مرن اسميناه "case" اما مدى الكود بشكل افقي فيقوم باخذ البيانات ابتداءاً من الخلية الثانية بدون المتسلسل ولو اردنا الترحيل بدون المسلسل فقط امسح السطر Sheet4.Cells(lstrow, "a") = Z: وهنا سيقوم بالترحيل بدون المسلسل والكود مكون من جمل تكرار مع استخدام اداة الشرط "If" واستخدام تعاريف الخلايا فقط وهنا الكود بشكله النهائي Dim c As Range For Each c In Sheet1.Range("case") If c.Value = "منقول" Then lstrow = Sheet4.Range("b20000").End(xlUp).Row + 1 Sheet4.Range(Sheet4.Cells(lstrow, "b"), Sheet4.Cells(lstrow, "ag")) = _ Sheet1.Range(Sheet1.Cells(c.Row, "b"), Sheet1.Cells(c.Row, "ag")).Value Sheet1.Range(Sheet1.Cells(c.Row, "b"), Sheet1.Cells(c.Row, "ag")) = Empty End If Next c
عبد الفتاح كيرة قام بنشر يوليو 23, 2011 قام بنشر يوليو 23, 2011 و هذا تعديل للكود الذى أوردته مع الشكر لأستاذنا الحسامى Sub Macro4() ' ' Macro4 ماكرو by kemas Dim LastR As Long Dim mycl As Range Dim myrng As Range ' Application.ScreenUpdating = False Set myrng = Sheets("الشيت").Range("n1:n41") For Each mycl In myrng LastR = Sheets("منقول").Range("a" & Rows.Count).End(xlUp).Row + 1 If mycl = "منقول" Then mycl.EntireRow.Cut Sheets("منقول").Range("a" & LastR) End If Next mycl Sheets("منقول").Select Application.ScreenUpdating = True End Sub
ياسر الحافظ قام بنشر يوليو 23, 2011 قام بنشر يوليو 23, 2011 استاذنا الحسامي - استاذنا كيماس روائع ... جزاكم الله كل الخير ملاحظة : عذرا استاذنا الحسامي قمت برفع مرفقك الى موضوع اكواد منفصلة تهم الجميع لللاستاذ محمد يحياوي وفقـــــــــــــــــــــــــــــــــــــــــــــــــــــكم الله ياسر الحافظ
الحسامي قام بنشر يوليو 23, 2011 قام بنشر يوليو 23, 2011 السلام عليكم اخي ياسر افعل ما يحلو لك للفائدة ومجهود تشكر عليه وبارك الله فيك اخي كيماس كود ممتاز ورائع
saad abed قام بنشر يوليو 23, 2011 قام بنشر يوليو 23, 2011 اخوانى اساتذة المنتدى كلما تعددت الحلول واختلفت طرق الوصول للهدف كلما تعلم المبتدئين امثالى كيف تكون الحلول بطرق مختلفة شكرا لكم تحياتى سعد عابد
شمس الثورة قام بنشر يوليو 23, 2011 الكاتب قام بنشر يوليو 23, 2011 اخوانى اساتذة المنتدى كيماس والحسامى اعمال رائعه ولكن اخى الحسامى ما نفع حذف السطر واكيد العيب فى شخصى فهل قمت بهذا العمل على الملف الرفق فى المشاركة اخى كيماس ملاحظة على تعديل الكود الخاص بك فانه يقوم بنقل التنسيقات وانا اريد نقل البيانات ويترك التنسيقات كما هى فى ورقة الشيت
شمس الثورة قام بنشر يوليو 23, 2011 الكاتب قام بنشر يوليو 23, 2011 اخوانى اساتذة المنتدى كيماس والحسامى اعمال رائعه ولكن اخى الحسامى ما نفع حذف السطر واكيد العيب فى شخصى فهل قمت بهذا العمل على الملف الرفق فى المشاركة اخى كيماس ملاحظة على تعديل الكود الخاص بك فانه يقوم بنقل التنسيقات وانا اريد نقل البيانات ويترك التنسيقات كما هى فى ورقة الشيت 0
الحسامي قام بنشر يوليو 24, 2011 قام بنشر يوليو 24, 2011 السلام عليكم بالنسبة لحذف الصف فهو كان ما طلب انا فهمت من الطلب بانك هكذا تريد واتوقع جميع الاخوة هكذا فهموا اذا لم يكن المطلوب مسح البيانات فقد امسح هذا السطر Sheet1.Range(Sheet1.Cells(c.Row, "b"), Sheet1.Cells(c.Row, "ag")) = Empty Dim c As Range For Each c In Sheet1.Range("case") If c.Value = "منقول" Then lstrow = Sheet4.Range("b20000").End(xlUp).Row + 1 Sheet4.Range(Sheet4.Cells(lstrow, "b"), Sheet4.Cells(lstrow, "ag")) = _ Sheet1.Range(Sheet1.Cells(c.Row, "b"), Sheet1.Cells(c.Row, "ag")).Value End If Next c
احمد فضيله قام بنشر يوليو 24, 2011 قام بنشر يوليو 24, 2011 السلام عليكم ورحمة الله و بركاته بعد اذن الاخوة الأعزاء فقط لإثراء الموضوع الاخ / شمس الثورة تفضل هذا المرفق و الله الموفق والمستعان و السلام عليكم ورحمة الله و بركاته المنقول HaNcOcK.rar
احمد فضيله قام بنشر يوليو 24, 2011 قام بنشر يوليو 24, 2011 و تفضل يا أخي هذا المرفق و هو حل بطريقة أخري فقط اكتب منقول ثم انتقل لشيت منقول و الله الموفق والمستعان و السلام عليكم ورحمة الله و بركاته المنقول HaNcOcK 2.rar
ياسر الحافظ قام بنشر يوليو 24, 2011 قام بنشر يوليو 24, 2011 اخي وصديقي الاستاذ احمد فضيلة " HaNcOk " : حلول اضافية جميلة جدا اعتقد ان اخونا " شمس الثورة " اصبح لديه خيارات واسعة ورائعة ... كلنا استفدنا كثيرا من هذا التنوع في الردود تشكر وفقك الله ياسر الحافظ " ابو الحارث "
احمد فضيله قام بنشر يوليو 25, 2011 قام بنشر يوليو 25, 2011 اخي وصديقي الاستاذ احمد فضيلة " HaNcOk " : حلول اضافية جميلة جدا اعتقد ان اخونا " شمس الثورة " اصبح لديه خيارات واسعة ورائعة ... كلنا استفدنا كثيرا من هذا التنوع في الردود تشكر وفقك الله ياسر الحافظ " ابو الحارث " السلام عليكم ورحمة الله و بركاته أخي الفاضل الاستاذ / ياسر الحافظ " ابو الحارث " بالفعل التنوع في الردود يفيدنا جميعاً و يعطينا أفكار مختلفة بارك الله فيك و جزاك الله كل خير على دعائك و شكراً لك على كلماتك الطيبة و الله الموفق والمستعان و السلام عليكم ورحمة الله و بركاته
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.