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

[علي الشيخ]

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

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

عند الضغط على زر الكود يتم بحث النطاق من 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

تم تعديل نوفمبر 29, 2020 بواسطه علي الشيخ
اضافة المرفق

[سليم حاصبيا]

هذا الكود

Option Explicit
Sub test1()
Dim sh As Worksheet
Dim Ro As Long
Dim i%, t%
Set sh = Sheets("test")
With sh
    Ro = .Range("G" & Rows.Count).End(3).Row
         .Range("B31:C39").ClearContents
    If Ro < 51 Then Exit Sub
    t = 31
    For i = 51 To Ro
        If UCase(.Range("G" & i)) = "YES" Then
        Range("B" & t).Value = _
        Range("B" & i).Value
         t = t + 1
         If t >= 40 Then Exit For
        End If
     Next i
End With

End Sub

 

[علي الشيخ]

استاذ سليم جزاك الله خيرا وزادك علما ونفع بك تم عمل المطلوب من خلال الكود بتاع حضرتك ولك جزيل الشكر.

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

دمتم عون لنا ما قصدتكم في اي استفسار الا وجبرتوا بخاطري صراحة ربنا يكرمكم.