اذهب الي المحتوي
أوفيسنا

ترحيل مشروط


skyblue

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

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

الاساتذة المشرفين والاعضاء الافاضل يوجد في الملف المرفق كود ترحيل واحتاج فقط الى التعديل في هذا الكود بناء على اسماء في القائمة المنسدلة

مرفق ملف وبه الايضاح

تحياتي

kk.rar

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

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

الاساتذة المشرفين والاعضاء الافاضل يوجد في الملف المرفق كود ترحيل واحتاج فقط الى التعديل في هذا الكود بناء على اسماء في القائمة المنسدلة

مرفق ملف وبه الايضاح

تحياتي

الاخوة الافاضل الملف KK به اخطاء ....مرفق لكم الملف الصحيح

الملف الصحيح.rar

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

السلام عليكم

لم افهم المطلوب

ارجو مراجعة عناوين الخلايا التى تريد ترحيلها

لان الخليه b11 تمثل عنوان ثابت موجود اصلا في الشيت الثانى

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

يسعدني ويشرفني انك انت من ترد على مشاركتي ومن حظي انه من خلال كم سنة واغلب الردود على موضوعي تكون منك ...والله هو العالم مدى الاستفادة التي استفدتها منك في كثير من المواضيع اشياء لاتقدر بثمن ولكن لك مني الدعاء في ظهر الغيب .

بخصوص موضوعي الحالي : فعلا الخلية b11 تعتبر عنوان ثابت في sheet2 ولكن b11 تكون فاضية عندما اطلب اسم سامي او سالم .

فطلبي باختصار على النحو التالي :

ااذا كانت القائمة المنسدلة تحتوي على اسم احمد او علي نقوم بترحيل الخلايا من d8-d11 الي sheet2 حسب عناوينها

واذا = = = = = = سامي او سالم = = الخلية b11 و الخلية d11 الى sheet2 كل حسب عنوانه.

=======================================================

Sub MoveValue2()

Dim EndRow As Long

If Target.Address = "$A$2" Then

Select Case Target.Value

Case Is = "علي", "احمد"

For i = 1 To 1

EndRow = Sheets(2).Range("A1").CurrentRegion.Rows.Count

Sheets(2).Cells(EndRow + 1, 1).Value = EndRow

Sheets(2).Cells(EndRow + 1, 2).Value = Sheets(1).Cells(8, 4).Value

Sheets(2).Cells(EndRow + 1, 3).Value = Sheets(1).Cells(9, 4).Value

Sheets(2).Cells(EndRow + 1, 4).Value = Sheets(1).Cells(10, 4).Value

Sheets(2).Cells(EndRow + 1, 5).Value = Sheets(1).Cells(11, 4).Value

Sheets(2).Cells(EndRow + 1, 7).Value = Sheets(1).Cells(2, 1).Value

Case Is = "سامي", "سالم"

Sheets(2).Cells(EndRow + 1, 8).Value = Sheets(1).Cells(11, 2).Value

End Select

End If

End Sub

تحياتي

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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information