ترحيل بيانات عند تحقق شرطين

[W W M]

ارجو المساعده عندى ملف مكون من صفحتين :

الصفحه الاولى يتم ادخال التاريخ واسم الموظف وساعه حضوره وساعه انصرافه

الصفحه الثانيه مطو ب نقل كل حضور وانصراف كما هو موضح فى الملف المرفق

وشكرا

Book1.rar

تم تعديل يوليو 19, 2009 بواسطه خبور خير

[عبدالله باقشير]

السلام عليكم

في المرفق الكود التالي:

Sub ترحيل()
Dim L As Integer, R As Integer, C As Integer, CC As Integer, RR As Integer
L = Range("A" & Rows.Count).End(xlUp).Row
With ورقة2
    For R = 2 To L
        For C = 1 To 17
            If Cells(R, 3).Value = .Cells(1, C).Value Then
                CC = .Cells(1, C).Column
                For RR = 3 To 33
                    If Cells(R, 2).Value = .Cells(RR, CC).Value Then
                        .Cells(RR, CC + 1) = Cells(R, 4)
                        .Cells(RR, CC + 2) = Cells(R, 5)
                    End If
                Next RR
            End If
        Next C
    Next R
End With
MsgBox "تم الترحيل بنجاح", vbMsgBoxRtlReading + vbMsgBoxRight, "الحمدلله"
End Sub

Book1.rar

[cat101]

شكرا شكرا

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

[يوسف عطا]

عزيزى الغالى خبور خير

بعد التحية

إسمحلى أن أطلب مساعدتك فى كود ترحيل بشروط معينة

وبعد إذن الأخ صاحب الدار ( الموضوع ) هذا رابط الموضوع الذى فيه طلبى

الف شكر مقدماً

الرابط من هنا

[naderwatfa]

الشكر لكم جميعاً .. منتدى خطير لولاه ما عرفت الإكسيل حق المعرفة

[ahmedhafez]

اخى الكريم لااعرف لماذا لا يعمل عندى

الخطا

If Cells(R, 3).Value = .Cells(1, C).Value Then

هل من الممكن مساعدتى

[W W M]

اشكرك يا استاذ خبور على سرعه الرد و

والله ينور عليك يا باشا

ولكن لى طلب عند سيادتك

شرح هذا الكود

وشكرا

[سالم شباني]

السلام عليكم

أخي wwm

لقد وضعت لك ملفا في المنتدى أرجو أن ينال إعجابك

طبعا ملف الأخ خبور في غاية الدقة و لا تعليق

إليك الرابط

http://www.officena.net/ib/index.php?showtopic=29267

[منياوى]

رائع والف الف شكر