ترحيل خاص

[mselmy]

الاخوه الاعزاء مرفق ملف اكسيل مطلوب عمل كود ترحيل به بالشكل المرفق فى الملف ولكم جزيل الشكر

سجل الحضور.rar

[عبدالله المجرب]

السلام عليكم

جرب هذا الكود

Sub Abu_Ahmed()

Dim CL As Range, C As Range, Ce As Range

For Each CL In Sheet2.[C3:O3]

If CL.Value = [C2] Then

For Each C In [B4:B9]

For Each Ce In Sheet2.[B4:B12]

If C.Value = Ce.Value And C.Offset(0, 1).Value = 1 Then

Sheet2.Cells(Ce.Row, CL.Column) = "لم يحضر"

End If

If C.Value = Ce.Value And C.Offset(0, 1).Value = "" Then

Sheet2.Cells(Ce.Row, CL.Column) = "حضر"

End If

Next

Next

End If

Next

End Sub

[mselmy]

تسلم ايدك

[mselmy]

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

[عبدالله المجرب]

جرب هذا التعديل

Sub Abu_Ahmed()

Dim CL As Range, C As Range, Ce As Range

LR = Range("B" & Rows.Count).End(xlUp).Row

For Each CL In Sheet2.[C3:O3]

If CL.Value = [C2] Then

For Each C In [B4:B50]

For Each Ce In Sheet2.[B4:B60]

If C.Row = LR Then Exit Sub

If C.Value = Ce.Value And C.Offset(0, 1).Value = 1 Then

Sheet2.Cells(Ce.Row, CL.Column) = "لم يحضر"

End If

If C.Value = Ce.Value And C.Offset(0, 1).Value = "" Then

Sheet2.Cells(Ce.Row, CL.Column) = "حضر"

End If

Next

Next

End If

Next

End Sub

[خالد القدس]

السلام عليكم

رائع استاذ عبدالله

بارك الله فيك

[mselmy]

شكرا على الاهتمام لكن الترجيل توقف بعد الطالب الاول و عند ترك الخلبيه الاولى خاليه يقوم بالترحيل للفراغات

[mselmy]

استادى العزيز عبد الله اشكرك شكرا جزيلا هلى اهتمامك لقد قمت بعمل تعديل على الكود الاول والحمد لله اوفى بالغرض واليك الكود

Sub Abu_Ahmed()

Dim CL As Range, C As Range, Ce As Range

For Each CL In Sheet2.[C3:O3]

If CL.Value = [C2] Then

For Each C In [b4:B30]

For Each Ce In Sheet2.[b4:B30]

If C.Value = Ce.Value And C.Offset(0, 1).Value = 1 And C.Value <> "" Then

Sheet2.Cells(Ce.Row, CL.Column) = "ÛíÇÈ"

End If

If C.Value = Ce.Value And C.Offset(0, 1).Value = "" And C.Value <> "" Then

Sheet2.Cells(Ce.Row, CL.Column) = "íÖÑ"

End If

Next

Next

End If

Next

End Sub

[abouelhassan]

لؤلؤ والماظ استاذنا الرائع عبدالله المجرب(ابواحمد)

الله يرضى عليك

امين

[asdhamdey]

جزاك الله كل خير استاذ عبد الله