ممكن تصحيح الكود هذا

[2saad]

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

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

الكود هذا يطبع 8بطاقات الجلوس للمدرسة في كل ورقة

ولكن فيه خطأ وعايز اصححه

الخطأ : عند الطباعة يطبع كل الأوراق ولكن في آ خر ورقة يطبع بطاقة واحدة من 8

وأنا عايزة يطبع كل البطاقات لاخر بطاقة

وشكرا جزيلا لأعضاء المنتدي الكرام الذين تعلمت منهم الكثير

'هذا الكود للنابغه ساجده العزاوي
' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه
'تم في اكتوبر 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("M13").Value & "*"
'===================
C = 0
Application.ScreenUpdating = False
    lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row   'اخر صف به بيانات
' عدد الصفوف الخارجة
'عن التوزيع في ورقة مصدر البيانات
  'هذا السطر في حال شهادات الكل
    
       
       'هذا السطر في حال طلب شهادات محدده
     '   For i = sh4.Cells(7, 18).Value To sh4.Cells(7, 19).Value
 For i = SHEHADA.[M4].Value To SHEHADA.[N4].Value
    '=======
If DATA.Cells(i, 7) Like targt & "*" And C = 0 Then
     Range("D2") = DATA.Cells(i, 2)
            C = C + 1
   ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 1 Then
     Range("J2") = DATA.Cells(i, 2)
            C = C + 1
      ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 2 Then
     Range("D15") = DATA.Cells(i, 2)
            C = C + 1
   ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 3 Then
     Range("J15") = DATA.Cells(i, 2)
            C = C + 1
    ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 4 Then
     Range("D28") = DATA.Cells(i, 2)
            C = C + 1
   ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 5 Then
     Range("J28") = DATA.Cells(i, 2)
            C = C + 1
     ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 6 Then
     Range("D41") = DATA.Cells(i, 2)
            C = C + 1
   ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 7 Then
     Range("J41") = 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 = SHEHADA.[N4] And C = 8 Then SHEHADA.Range("G41:K53").PrintOut: Exit For
    If i = SHEHADA.[N4] And C = 7 Then SHEHADA.Range("A41:F53").PrintOut: Exit For
     If i = SHEHADA.[N4] And C = 6 Then SHEHADA.Range("G28:K39").PrintOut: Exit For
     If i = SHEHADA.[N4] And C = 5 Then SHEHADA.Range("A28:F39").PrintOut: Exit For
     If i = SHEHADA.[N4] And C = 4 Then SHEHADA.Range("G15:K26").PrintOut: Exit For
     If i = SHEHADA.[N4] And C = 3 Then SHEHADA.Range("A15:F26").PrintOut: Exit For
    If i = SHEHADA.[N4] And C = 2 Then SHEHADA.Range("G1:K13").PrintOut: Exit For
    If i = SHEHADA.[N4] And C = 1 Then SHEHADA.Range("A1:F13").PrintOut: Exit For
     If i < SHEHADA.[N4] And (Range("D41") = "" Or Range("J41") = "") Then GoTo 1
    
    If i < SHEHADA.[N4] And C = 8 Then SHEHADA.Range("A1:K53").PrintOut
  
      C = 0
     Range("D2") = ""
     Range("J2") = ""
     Range("D15") = ""
     Range("J15") = ""
     Range("D28") = ""
     Range("J28") = ""
     Range("D41") = ""
     Range("J41") = ""
    ' Range("M51") = ""
    
1:
   Next i
     Range("D2") = ""
     Range("J2") = ""
     Range("D15") = ""
     Range("J15") = ""
     Range("D28") = ""
     Range("J28") = ""
     Range("D41") = ""
     Range("J41") = ""
    ' Range("M51") = ""
   Application.ScreenUpdating = True
End Sub

عند وضع كود يتم وضع عن طريق ايقونه الكود وهى

 <>

يرجي ارفاق ملف