ترحيل غياب الطلبة

[خالد الشاعر]

السادة الخبراء

 

مرفق ملف للغياب من هذا المنتدى العظيم

 

اضفت له كود ترحيل ولكنى احس انه كبير

 

فهل ممكن اختصار هذا الكود

 

مرفق الملف به زر ترحيل برجاء المساعدة

 

ولكم جزيل الشكر

ABS.rar

[رجب جاويش]

أخى الفاضل / خالد

استخدم هذا الكود

Sub ترحيـل()
Range("AI8:AI117").Copy
Select Case Range("E3").Value
Case Is = 9
Range("AL8").PasteSpecial Paste:=xlPasteValues
Case Is = 10
Range("AM8").PasteSpecial Paste:=xlPasteValues
Case Is = 11
Range("AN8").PasteSpecial Paste:=xlPasteValues
Case Is = 12
Range("AO8").PasteSpecial Paste:=xlPasteValues
Case Is = 1
Range("AP8").PasteSpecial Paste:=xlPasteValues
Case Is = 2
Range("AR8").PasteSpecial Paste:=xlPasteValues
Case Is = 3
Range("AS8").PasteSpecial Paste:=xlPasteValues
Case Is = 4
Range("AT8").PasteSpecial Paste:=xlPasteValues
Case Is = 5
Range("AU8").PasteSpecial Paste:=xlPasteValues
Case Is = 6
Range("AV8").PasteSpecial Paste:=xlPasteValues
End Select
Application.CutCopyMode = False
Range("B6").Select
End Sub

[رجب جاويش]

ولو أردت اختصار أكثر استخدم هذا

Sub ترحيـل()
Range("AI8:AI117").Copy
Select Case Range("E3").Value
Case 9 To 12
Cells(8, Range("E3").Value + 29).PasteSpecial Paste:=xlPasteValues
Case Is = 1
Range("AP8").PasteSpecial Paste:=xlPasteValues
Case 2 To 6
Cells(8, Range("E3").Value + 42).PasteSpecial Paste:=xlPasteValues
End Select
Application.CutCopyMode = False
Range("B6").Select
End Sub

[خالد الشاعر]

استاذ رجب

 

الف شكر على هذا الكود الممتاز

 

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

[رجب جاويش]

أخى الفاضل / خالد

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

[hafez81]

مشكور اخي العزيز