محمد عبد الناصر قام بنشر نوفمبر 18, 2020 مشاركة قام بنشر نوفمبر 18, 2020 احتاج الى كود يقوم بنقل الصفوف على حسب الاسم المكتوب في الخلية A2 فاذا كان الاسم مثلا رخام ان يقوم بالنقل اذا كان مكتوب كلمة رخام فمثلا اذا كان مكتوب توريد وتركيب رخام ان يقوم بنقل الصف تلوين.xlsm رابط هذا التعليق شارك More sharing options...
وجيه شرف الدين قام بنشر نوفمبر 18, 2020 مشاركة قام بنشر نوفمبر 18, 2020 اتفضل الشيت لعله بفى بالغرض اما بالنسبة شبت الدمج انظر اليه قد التعديل على الكود نسخة من تلوين 222.xlsm 2 رابط هذا التعليق شارك More sharing options...
محي الدين ابو البشر قام بنشر نوفمبر 18, 2020 مشاركة قام بنشر نوفمبر 18, 2020 جرب تلوين.xlsm 3 رابط هذا التعليق شارك More sharing options...
محمد عبد الناصر قام بنشر نوفمبر 18, 2020 الكاتب مشاركة قام بنشر نوفمبر 18, 2020 ماشاء الله استاذ محي الدين هو المطلوب تماما استاذ محي الدين لو عايز اخليه ياخذ الملفات قص وليس نسخ ممكن ؟ بحيث انه يشيل الاسطر التي تم نقلها لا اريدها اريد ان يعمل قص وليس نسخ رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر نوفمبر 18, 2020 أفضل إجابة مشاركة قام بنشر نوفمبر 18, 2020 بعد اذن الاستاذ وجيه لا استطيع الا أن أعطي ملاحظات لماذا لا نستغني عن الحلقة التكرارية (J) الثانية ؟؟ لأن الحلقات التكرارية ترهق البرنامج اذا كانت البيانات كبيرة و ذلك باعتماد هذا الكود Sub aa() Dim ws As Worksheet: Set ws = Sheets("Sheet1") Dim sh As Worksheet: Set sh = Sheets("Sheet2") sh.Range("a7:e55") = "" k = 7 lr = ws.Range("a" & Rows.Count).End(xlUp).Row For i = 7 To lr If ws.Range("b2") = ws.Range("c" & i) Then sh.Cells(k, 1).Resize(, 5).Value = _ ws.Range("A" & i).Resize(, 5).Value k = k + 1 End If Next sh.Activate End Sub 2 رابط هذا التعليق شارك More sharing options...
وجيه شرف الدين قام بنشر نوفمبر 18, 2020 مشاركة قام بنشر نوفمبر 18, 2020 حبيبى استاذ سليم وهو فى استاذن معلم من تلميذه وهو بنتعلم منكم 2 رابط هذا التعليق شارك More sharing options...
عبدالفتاح في بي اكسيل قام بنشر نوفمبر 18, 2020 مشاركة قام بنشر نوفمبر 18, 2020 اعتقد انه بالفلترة افضل من الحلقات التكرارية Sub cutpaste_Rows() Application.ScreenUpdating = False Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Set srcWS = Sheets("sheet1") Set desWS = Sheets("sheet2") With srcWS .Cells(6, 1).CurrentRegion.AutoFilter 3, Range("a2").Value .AutoFilter.Range.Offset(1).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1) .AutoFilter.Range.Offset(1).EntireRow.Delete .Range("A1").AutoFilter End With Application.ScreenUpdating = True End Sub تلوين (1).xlsm 3 رابط هذا التعليق شارك More sharing options...
وجيه شرف الدين قام بنشر نوفمبر 19, 2020 مشاركة قام بنشر نوفمبر 19, 2020 واثراء للموضوع هذا حل اخر بالمعادلات نسخة من تلوين666.xlsm 1 رابط هذا التعليق شارك More sharing options...
محمد عبد الناصر قام بنشر نوفمبر 19, 2020 الكاتب مشاركة قام بنشر نوفمبر 19, 2020 ماشاء الله اساتذتي الكرام لقد انعم الله عليكم بالعلم واراكم لا تبخلون على احد والله ادعي لكم كل يوم على هذه المجهودات بارك الله فيكم بارك الله فيكم ورزقكم كل خير رابط هذا التعليق شارك More sharing options...
محي الدين ابو البشر قام بنشر نوفمبر 19, 2020 مشاركة قام بنشر نوفمبر 19, 2020 إليك تلوين.xlsm 2 رابط هذا التعليق شارك More sharing options...
محمد عبد الناصر قام بنشر نوفمبر 19, 2020 الكاتب مشاركة قام بنشر نوفمبر 19, 2020 ما شاء الله استاذ محي الدين بارك الله فيك وفي علمك وزادك من علمه رابط هذا التعليق شارك 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.