أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
هانى على ali mohamed ali-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة منع ادخال البيانات بعدة شروط اكسيل اسئله واجابات


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





تعديل على كود VBA لنسخ خلايا إلى نطاق معين في وجود شرط معين

السلام عليكم ورحمة الله وبركاته فضلا المساعدة في التعديل على الكود التالي والتي تتلخص وظيفته في التالي عند الضغط عل ..


موضوع مغلق


30-11-2020 12:37 صباحا
aelsheikh
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 12-03-2020
رقم العضوية : 18494
المشاركات : 7
الجنس : ذكر
تاريخ الميلاد : 24-10-1987
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 14
 offline 


السلام عليكم ورحمة الله وبركاته 


فضلا المساعدة في التعديل على الكود التالي والتي تتلخص وظيفته في التالي

عند الضغط على زر الكود يتم بحث النطاق من G75:G114  وكل خليه يوجد فيها YES (و YES  دي نتيجة معادلة معينة موجودة في الخلية)

يتم نسخ القيمة في المقابلة الموجودة في العمود B  ليتم نسخ كل الخلايا المقابلة لكلمة YES في النطاق الجديد في نفس الشيت بدأ من الخلية B29 الى الخلية B36



Sub test1()

Dim rcnt As Long
rcnt = Worksheets("ALEX").Range("g" & Rows.Count).End(xlUp).Row
For i = 1 To rcnt
If Range("G" & i).Value = "YES" Then
    
    Range("G" & i).Offset(0, -5).Copy
    Range("B30").Offset(1, 0).PasteSpecial xlPasteAll
    
    End If
   Next i
    
Application.CutCopyMode = False
End Sub


مرفق الملف الاصلي المطلوب العمل عليه وتم الايضاح عليه وان شاء الله اكون قدرت اوصل المطلوب وجزاكم الله خيرا
 
 
  test drat 3.xlsm   تحميل xlsm مرات التحميل :(9)
الحجم :(33.585) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
وعليكم السلام
جرب الكود بهذا الشكل
Sub MyTest()
    Dim r As Long, m As Long
    m = 30
    For r = 51 To 119
        If Cells(r, "G").Value = "YES" Then
            m = m + 1
            If m > 39 Then MsgBox "No More", vbExclamation: Exit Sub
            Cells(m, 2).Value = Cells(r, 2).Value
        End If
    Next r
End Sub
عرض الإجابة




30-11-2020 12:51 صباحا
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10444
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36522
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif تعديل على كود VBA لنسخ خلايا إلى نطاق معين في وجود شرط معين
وعليكم السلام
جرب الكود بهذا الشكل
Sub MyTest()
    Dim r As Long, m As Long
    m = 30
    For r = 51 To 119
        If Cells(r, "G").Value = "YES" Then
            m = m + 1
            If m > 39 Then MsgBox "No More", vbExclamation: Exit Sub
            Cells(m, 2).Value = Cells(r, 2).Value
        End If
    Next r
End Sub



الكلمات الدلالية
تعديل ، لنسخ ، خلايا ، نطاق ، معين ، وجود ، معين ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 07:30 صباحا