اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

الردود الموصى بها

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

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

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

تم تعديل بواسطه علي الشيخ
اضافة المرفق
رابط هذا التعليق
شارك

  • أفضل إجابة

هذا الكود

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

 

  • Like 2
رابط هذا التعليق
شارك

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

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

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

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information