ترحيل مشروط

[2saad]

إخواني أعضاء المنتدي الكرام بعد سلام الله عليكم ورحمته وبركاته

محتاج كود يقوم بترحيل وطباعة الخلايا من شيت1 الي شيت 2 التي باللون الأصفر وبها دالة (VLOOCUP  ) بناء علي رقم الكود المثبت بالخلية ( Q1 ) والقائمة المنسدلة الملونة باللون الاخضر

ولكم جزيل الشكرNew Microsoft Excel Worksheet (2).xlsm

[محمد هشام.]

هل ممكن ارفاق صورة او عينة للنتيجة المتوعقة 

[2saad]

شكرا لرد حضرتك يا أستاذ / محمد 

المطلوب :

 

يعني عند الصغط علي القائمة المنسدلة الموجودة بالشيت الثاني واختيار مثلا ( الأول1 ) يقوم الكود بجلب الاسم والمادةالملونة باللون الأصفر الموجود أمامها ( الأول1 ) من الشيت الأول وطباعتها متتالية. وهكذا

يا ريت يكون وصل المطلوب.

ولكم جزيل الشكر .New Microsoft Excel Worksheet (2).xlsm

[lionheart]

Try

Sub Test()
    Dim a, e, ws As Worksheet, sh As Worksheet, i As Long
    Set ws = ThisWorkbook.Worksheets(1): Set sh = ThisWorkbook.Worksheets(2)
    a = ws.Range("B11:J" & ws.Cells(Rows.Count, "B").End(xlUp).Row).Value
    e = sh.Range("Q3").Value
    For i = LBound(a) To UBound(a)
        If a(i, 8) = e Then
            sh.Range("F9").Value = a(i, 2)
            sh.Range("M9").Value = a(i, 9)
            Application.Wait Now + TimeValue("00:00:01")
            Rem sh.PrintOut
        End If
    Next i
End Sub

 

[2saad]

شكرا لرد حضرتك

بس مفيش طباعة للورقة ؟

[lionheart]

Very weird

I have commented this line as I didn't want to print

Rem sh.PrintOut

Rem is used to make the line as a comment. Just remove the Rem and the sheet will be printed

Another point I have put this line just for wait, you can remove this line

Application.Wait Now + TimeValue("00:00:01")

 

Try to understand the code. Don't wait others to do the whole work for you

[2saad]

حضرتك يا ريت تكلمني عربي

علشان افهم ما تقول

شكرا جزيلا وجزاك الله كل خير

أنا فهمت كلام حضرتك وعملت المطلوب

[محمدي عبد السميع]

يحفظكم الرحمن الرحيم

[حسونة حسين]

نورت المنتدى استاذ محمدى عبدالسميع