مساعدة في الكود

[2saad]

الاخوة االأفاضل الذين تعلمت منهم الكثير وربنا يجعله في ميزان حسناتهم

محتاج كود ترحيل   البيانات من شيت   data  الي شيت laskat

مستخدما القائمة المنسدلة للفصول في الخلية s8 كما هو موضح

اسم التلميذ

الصف

الفصل

تاريخ الميلاد

 

 

ولكم جزيل الشكر ووافر الاحترام

رزان.xlsm

[ابراهيم الحداد]

السلام عليكم ورحمة الله

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

Sub CallSude()
Dim ws As Worksheet, Sh As Worksheet
Dim i As Long, p As Long, j As Long
Dim LR As Long, Fasl As String
Application.ScreenUpdating = False

Set ws = Sheets("laskat")
For x = 3 To 58 Step 5
ws.Cells(x, 3).ClearContents
ws.Cells(x + 1, 3).ClearContents
ws.Cells(x + 1, 6).ClearContents
ws.Cells(x + 2, 4).ClearContents

ws.Cells(x, 12).ClearContents
ws.Cells(x + 1, 12).ClearContents
ws.Cells(x + 1, 15).ClearContents
ws.Cells(x + 2, 13).ClearContents
Next

Fasl = ws.Range("S8").Text
Set Sh = Sheets("data")
LR = Sh.Range("C" & Rows.Count).End(3).Row

For i = 3 To LR
If Sh.Cells(i, 14) = Fasl Then
p = p + 1
j = 2
Do While j <= 57
If ws.Cells(j, 8) = p Then
ws.Cells(j + 1, 3) = Sh.Cells(i, 3)
ws.Cells(j + 2, 3) = Sh.Cells(i, 15)
ws.Cells(j + 2, 6) = Sh.Cells(i, 14)
ws.Cells(j + 3, 4) = Sh.Cells(i, 5)

ElseIf ws.Cells(j, 17) = p Then
ws.Cells(j + 1, 12) = Sh.Cells(i, 3)
ws.Cells(j + 2, 12) = Sh.Cells(i, 15)
ws.Cells(j + 2, 15) = Sh.Cells(i, 14)
ws.Cells(j + 3, 13) = Sh.Cells(i, 5)

End If
j = j + 5
Loop
End If
Next

Application.ScreenUpdating = True
End Sub

 

[2saad]

اخي الفاضل بارك الله فيك علي الكود الجميل

ولكن عند التطبيق يظهر خطأ في اللاصقات

وكمان القائمة المنسدلة مبتغيرش الفصول لاني عامل قائمة منسدلة المفروض ادوس عليها واختار الفصل يعمل تعبأة لللاصقات

واليك الملف بعد التطبيقرزان.xlsm

 

[2saad]

استاذي الفاضل ابراهيم

ستاذي الفاضل معلش انا تعبتك معاي وشكرا علي ردك ومساعدتك لي
انا كلما اختار فصل واضغط علي زر الترحيل يوم بتعبأة 24 تلميذ فقط في اللاصقات ولكن عدد الفصل يصل 60 يعني ناقص كثير
ايه الحل ؟؟
شكرا واكرر آسفي رزان.xlsm