تعديل كود الترحيل

[2saad]

إخواني أعضاء المنتدي الكرام بعد سلام الله عليكم ورحمته وبركاته

هذا كود لعمل ترحيل لبيانات التلميذ 

ولكن لا يرحل كل التلاميذ بيعدي 1 أو اثنين

عايز اعرف ايه الخطا

 'هذا الكود للنابغه ساجده العزاوي
' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه
'تم في اكتوبر 2017
'كمعطيات المحترم ابو أحمد محمدي
'الهدف من الكود هو استخراج الشهادات
'كل 3 شهادات في صفحه واحدة
'بثلاث معايير
'=*=*=*=*=*
 Dim SHEHADA As Worksheet, DATA As Worksheet
 Dim myArray, targt, targt2 As String
 
    'اسم صفحة المصدر
    Set DATA = Worksheets("ص")
    
     'اسم صفحة الهدف
    Set SHEHADA = Worksheets("جدول الامتحان مع رقم الجلوس ")
'===================
 
   ' targt3 = "5/1"
    targt = SHEHADA.Range("N125").Value & "*"
'===================
C = 0
Application.ScreenUpdating = False
    lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row   'اخر صف به بيانات

' عدد الصفوف الخارجة
'عن التوزيع في ورقة مصدر البيانات
  'هذا السطر في حال شهادات الكل
       For i = 14 To lr      
       'هذا السطر في حال طلب شهادات محدده
     '   For i = sh4.Cells(7, 18).Value To sh4.Cells(7, 19).Value
    '=======
If DATA.Cells(i, 5) Like targt & "*" And C = 0 Then
     Range("E117") = DATA.Cells(i, 2)
            C = C + 1
   ElseIf DATA.Cells(i, 5) Like targt & "*" And C = 1 Then
     Range("E130") = DATA.Cells(i, 2)
            C = C + 1
      ElseIf DATA.Cells(i, 5) Like targt & "*" And C = 2 Then
     Range("E143") = DATA.Cells(i, 2)
            C = C + 1
   ElseIf DATA.Cells(i, 5) Like targt & "*" And C = 3 Then
     Range("E156") = DATA.Cells(i, 2)
            C = C + 1
  ' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 3 Then
    ' SHEHADA.Range("M51") = DATA.Cells(i, 2)
           ' c = c + 1
            '===
            End If
     If i = lr And C = 4 Then SHEHADA.Range("A149:L160").PrintOut: Exit For
     If i = lr And C = 3 Then SHEHADA.Range("A136:L147").PrintOut: Exit For
    If i = lr And C = 2 Then SHEHADA.Range("A123:L134").PrintOut: Exit For
    If i = lr And C = 1 Then SHEHADA.Range("A109:L121").PrintOut: Exit For
     If i < lr And (Range("E143") = "" Or Range("E156") = "") Then GoTo 1
    If i < lr And C = 4 Then SHEHADA.Range("A109:L160").PrintOut
      C = 0
     Range("E117") = ""
     Range("E130") = ""
     Range("E143") = ""
      Range("E156") = ""
    ' Range("M51") = ""
    
1:
   Next i
     Range("E117") = ""
     Range("E130") = ""
     Range("E143") = ""
      Range("E156") = ""

    ' Range("M51") = ""
   Application.ScreenUpdating = True
End Sub

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