شمس الثورة قام بنشر يوليو 22, 2011 مشاركة قام بنشر يوليو 22, 2011 السلام عليكم ابحث عن كود عن طريقه تنقل البيانات فقط من الشيت الى كشف المنقولين دون حذف اى صف من ورقة الشيت بمعنى كود ينقل البيانات فقط وينقل البيانات كاملة وجعلكم الله فى عون المحتاج فعند كتاية منقول يتم نقل البيانات فقط الى صفحة المنقول ويترك الصف فارغ المنقول.rar 1 رابط هذا التعليق شارك More sharing options...
عبد الفتاح كيرة قام بنشر يوليو 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 رابط هذا التعليق شارك More sharing options...
شمس الثورة قام بنشر يوليو 23, 2011 الكاتب مشاركة قام بنشر يوليو 23, 2011 السلام عليكم الخىkemas عمل رائع ولكن بعد ترحيل البانات عند الضغط على زر الترحيل يتم حذف البيانات التى كانت موجوده فانا اريد عندما لكتب منقول فى الشيت واضغط زر الترحيل يتم نقل البيانات مثلما فعلت انت ولكن لا يمسح البانات التى رحلت مسبقا فانا عندما رحلت البيانات ثم ضغط مره اخرى على الزر قام بمسح البيانات ارجو مساعدتك رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر يوليو 23, 2011 مشاركة قام بنشر يوليو 23, 2011 لكتب منقول فى الشيت واضغط زر الترحيل يتم نقل البيانات مثلما فعلت انت ولكن لا يمسح البانات التى رحلت مسبقا فانا عندما رحلت البيانات ثم ضغط مره اخرى على الزر قام بمسح البيانات ارجو مساعدتك اخي شمس تفضل المرفق بعد التعديل المنقول-kemas.rar رابط هذا التعليق شارك More sharing options...
ياسر الحافظ قام بنشر يوليو 23, 2011 مشاركة قام بنشر يوليو 23, 2011 الاخوة / الاساتذة : كيماس " ابو عمر " - عبد الله المجرب " ابو احمد " جزاكم الله كل الخير على هذه الاكواد الرائعة احببت ان اشارك معكم في هذا الموضوع ( من باب المشاركة والتنوع ) كود يقوم بالترحيل ويجمع المنقولين في الورقة ( منقول ) ولكنه يحذف الاصل من الورقة ( الشيت ) عسى ان ينتفع به اخونا العزيز " شمس الثورة " وفقكم الله ياسر الحافظ تجميع المنقولين مع حذف الاصل.rar رابط هذا التعليق شارك More sharing options...
يحيى حسين قام بنشر يوليو 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 رابط هذا التعليق شارك More sharing options...
MAHMOUD ALI YOUSSEF قام بنشر يوليو 23, 2011 مشاركة قام بنشر يوليو 23, 2011 (معدل) السلام عليكم تحية خاصة لكل من الاستاذة الكبار يحي حسين ياسر الحافظ ابو احمد كيماس مع حفظ الالقاب علي مجهوداتهم الرائعة التي استفدت منها كثرا وشكرا تم تعديل يوليو 23, 2011 بواسطه MAHMOUDFOXMAM رابط هذا التعليق شارك More sharing options...
شمس الثورة قام بنشر يوليو 23, 2011 الكاتب مشاركة قام بنشر يوليو 23, 2011 السلام عليكم تحية خاصة لكل من الاستاذة الكبار يحي حسين ياسر الحافظ ابو احمد كيماس ولكن طلبى لم يوضح انا اريد ترحيل البيانات فقط من ورقة شيت الى ورقة منقول دون ان يؤثر على تنسيق زرقة الشيت فكود اخى كيماس جيد وهو المطلوب ولكن عند الضغط على الزر مرة اخرى يمسح البانات التى فى ورقة منقول وكود اخى عبدالله المجرب جميل جدا ولكن لم يتم مسح البيانات المرحلة من ورقة الشيت فظلت كما هى فى ورقة الشيت فارجو التعديل وجزاكم الله خيرا رابط هذا التعليق شارك More sharing options...
الحسامي قام بنشر يوليو 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 رابط هذا التعليق شارك More sharing options...
شمس الثورة قام بنشر يوليو 23, 2011 الكاتب مشاركة قام بنشر يوليو 23, 2011 مبدع استاذنا الحسامى ولى بعض الاسئلة هل يمكن شرح مبسط لهذا الكود ثانيا اذا احببت تغير المدى الذى تنقل منه البيانات بمعنى مثلا لا يتم نقل المسلسل مثلا فماذا اغير فى الكود رابط هذا التعليق شارك More sharing options...
الحسامي قام بنشر يوليو 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 رابط هذا التعليق شارك More sharing options...
عبد الفتاح كيرة قام بنشر يوليو 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 رابط هذا التعليق شارك More sharing options...
ياسر الحافظ قام بنشر يوليو 23, 2011 مشاركة قام بنشر يوليو 23, 2011 استاذنا الحسامي - استاذنا كيماس روائع ... جزاكم الله كل الخير ملاحظة : عذرا استاذنا الحسامي قمت برفع مرفقك الى موضوع اكواد منفصلة تهم الجميع لللاستاذ محمد يحياوي وفقـــــــــــــــــــــــــــــــــــــــــــــــــــــكم الله ياسر الحافظ رابط هذا التعليق شارك More sharing options...
ياسر الحافظ قام بنشر يوليو 23, 2011 مشاركة قام بنشر يوليو 23, 2011 عذرا رابط هذا التعليق شارك More sharing options...
الحسامي قام بنشر يوليو 23, 2011 مشاركة قام بنشر يوليو 23, 2011 السلام عليكم اخي ياسر افعل ما يحلو لك للفائدة ومجهود تشكر عليه وبارك الله فيك اخي كيماس كود ممتاز ورائع رابط هذا التعليق شارك More sharing options...
saad abed قام بنشر يوليو 23, 2011 مشاركة قام بنشر يوليو 23, 2011 اخوانى اساتذة المنتدى كلما تعددت الحلول واختلفت طرق الوصول للهدف كلما تعلم المبتدئين امثالى كيف تكون الحلول بطرق مختلفة شكرا لكم تحياتى سعد عابد رابط هذا التعليق شارك More sharing options...
شمس الثورة قام بنشر يوليو 23, 2011 الكاتب مشاركة قام بنشر يوليو 23, 2011 اخوانى اساتذة المنتدى كيماس والحسامى اعمال رائعه ولكن اخى الحسامى ما نفع حذف السطر واكيد العيب فى شخصى فهل قمت بهذا العمل على الملف الرفق فى المشاركة اخى كيماس ملاحظة على تعديل الكود الخاص بك فانه يقوم بنقل التنسيقات وانا اريد نقل البيانات ويترك التنسيقات كما هى فى ورقة الشيت رابط هذا التعليق شارك More sharing options...
شمس الثورة قام بنشر يوليو 23, 2011 الكاتب مشاركة قام بنشر يوليو 23, 2011 اخوانى اساتذة المنتدى كيماس والحسامى اعمال رائعه ولكن اخى الحسامى ما نفع حذف السطر واكيد العيب فى شخصى فهل قمت بهذا العمل على الملف الرفق فى المشاركة اخى كيماس ملاحظة على تعديل الكود الخاص بك فانه يقوم بنقل التنسيقات وانا اريد نقل البيانات ويترك التنسيقات كما هى فى ورقة الشيت 0 رابط هذا التعليق شارك More sharing options...
الحسامي قام بنشر يوليو 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 رابط هذا التعليق شارك More sharing options...
احمد فضيله قام بنشر يوليو 24, 2011 مشاركة قام بنشر يوليو 24, 2011 الاخوه الأعزاء جزاكم الله كل خير رابط هذا التعليق شارك More sharing options...
احمد فضيله قام بنشر يوليو 24, 2011 مشاركة قام بنشر يوليو 24, 2011 السلام عليكم ورحمة الله و بركاته بعد اذن الاخوة الأعزاء فقط لإثراء الموضوع الاخ / شمس الثورة تفضل هذا المرفق و الله الموفق والمستعان و السلام عليكم ورحمة الله و بركاته المنقول HaNcOcK.rar رابط هذا التعليق شارك More sharing options...
احمد فضيله قام بنشر يوليو 24, 2011 مشاركة قام بنشر يوليو 24, 2011 و تفضل يا أخي هذا المرفق و هو حل بطريقة أخري فقط اكتب منقول ثم انتقل لشيت منقول و الله الموفق والمستعان و السلام عليكم ورحمة الله و بركاته المنقول HaNcOcK 2.rar رابط هذا التعليق شارك More sharing options...
ياسر الحافظ قام بنشر يوليو 24, 2011 مشاركة قام بنشر يوليو 24, 2011 اخي وصديقي الاستاذ احمد فضيلة " HaNcOk " : حلول اضافية جميلة جدا اعتقد ان اخونا " شمس الثورة " اصبح لديه خيارات واسعة ورائعة ... كلنا استفدنا كثيرا من هذا التنوع في الردود تشكر وفقك الله ياسر الحافظ " ابو الحارث " رابط هذا التعليق شارك More sharing options...
احمد فضيله قام بنشر يوليو 25, 2011 مشاركة قام بنشر يوليو 25, 2011 اخي وصديقي الاستاذ احمد فضيلة " HaNcOk " : حلول اضافية جميلة جدا اعتقد ان اخونا " شمس الثورة " اصبح لديه خيارات واسعة ورائعة ... كلنا استفدنا كثيرا من هذا التنوع في الردود تشكر وفقك الله ياسر الحافظ " ابو الحارث " السلام عليكم ورحمة الله و بركاته أخي الفاضل الاستاذ / ياسر الحافظ " ابو الحارث " بالفعل التنوع في الردود يفيدنا جميعاً و يعطينا أفكار مختلفة بارك الله فيك و جزاك الله كل خير على دعائك و شكراً لك على كلماتك الطيبة و الله الموفق والمستعان و السلام عليكم ورحمة الله و بركاته رابط هذا التعليق شارك 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.