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

لوحة التميز الأسبوعي
العضو المتميز	المشرف المتميز	المراقب المتميز	المدير المتميز	الموضوع المتميز	القسم المتميز

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

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

الرئيسية

منتدى الاكسيل

اكسيل اسئله واجابات

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

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

: موضوع مغلق

حالة الموضوع : مغلق
أدوات الموضوع

أدوات الموضوع

تحميل محتوى الموضوع

عرض نسخة صالحة للطباعة

أرسل هذا الموضوع إلى صديق

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

30-11-2020 12:37 صباحا

aelsheikh

عضو

تاريخ الإنضمام : 12-03-2020

رقم العضوية : 18494

المشاركات : 7

الجنس :

تاريخ الميلاد : 24-10-1987

يتابعهم : 1

يتابعونه : 0

قوة السمعة : 14

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

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

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

: تعديل على كود 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 صباحا