Sub Macro5()
' Macro recorded 27/06/2010 by hosami
Application.ScreenUpdating = False
For j = 1 To 12
Sheets(j).Range("a4:d100").ClearContents
z = 1
For i = 4 To Application.CountA(Sheets("All").Range("a4:a1000")) + 10
If Sheets("All").Cells(i, "d") = j Then
For k = 1 To 4
Sheets(j).Cells(z, k) = Sheets("All").Cells(i, k)
Next k
z = z + 5
End If
Next i
Next j
End Sub
جزاك الله كل خير اخي العمده
هذا الكود مفيد ويمكن استخدامه في استخراج شيتات الناجحين والدور التاني
اذا تم الغاء الاربغ اسطر الفارغه
واذا تم جعل خلية التصغيه خارج الجدول
واذا تم شرح الكود حتى يصلح للجميع استخدامه في ملفات مختلفة
معذره للتداخل
ودمتم في رعاية الله