محتاج كود نقل أعمدة

[2saad]

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

محتاج كود لنقل البيانات من الأعمدة الملونة في شيت ( control1 ) الي شيت ( تقييم عام ) بحيث كل 25 صف في ورقة ويكمل في صفحة بعدها 25 وهكذا الي ان تنتهي جميع الصفوف 

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

[محمد هشام.]

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

 

Sub test()
Dim j, F, Fin&, i&, R&
Dim Tb1 As Worksheet: Set Tb1 = Worksheets("control1")
Dim Tb2 As Worksheet: Set Tb2 = Worksheets("تقييم عام")

F = 1: j = 12

Application.ScreenUpdating = False
For Fin = 10 To Tb1.Cells(Tb1.Rows.Count, "c").End(xlUp).Row

If Tb1.Range("C" & Fin) <> "" Then
Tb2.Range("D" & j) = Tb1.Range("C" & Fin): Tb2.Range("E" & j) = Tb1.Range("E" & Fin)
 Tb2.Range("F" & j) = Tb1.Range("G" & Fin): Tb2.Range("G" & j) = Tb1.Range("K" & Fin)
   Tb2.Range("H" & j) = Tb1.Range("L" & Fin)
     
If F = 25 Then
  j = j + 8: F = 1
Else
j = j + 1: F = F + 1
    End If
  End If
Next
R = 1
For Col = 12 To Tb2.Range("D" & Tb2.Rows.Count).End(xlUp).Row
If Tb2.Range("D" & Col) <> "" Then: Tb2.Range("C" & Col) = R: R = R + 1
If R = 26 Then: R = 1

  Next Col
Application.ScreenUpdating = True

End Sub

 

[2saad]

شكرا جزيلا يا استاذ محمد