Döngü ile tablo aktarımı

[Hakan ERDOST]

Elimde bir sayfada alt alta öğrenci sınav sonuçları var. Bunları diğer sayfada birleştirmeye çalışırken döngü kurmakta sıkıntı çekiyorum. Dosya ekte isteiğim 2.sayfadaki tabloya öğrencilerin ders sonuçlarını aktarmak ilk dersi aktardım ancak diğer derslerde döngü mantığı kuramadım.

 

[Ömer]

Merhaba,

Deneyiniz.

Sub Aktar()
    
    Dim S1 As Worksheet, i As Long, sat As Long, j As Byte
    
    Set S1 = Sheets("Sayfa1")
    
    Application.ScreenUpdating = False
    Sheets("Sayfa2").Select
    Range("A2:G" & Rows.Count) = ""
    
    sat = 2
    For i = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row Step 72
        For j = 1 To 4
            Cells(sat, "A") = sat - 1
            Cells(sat, "B") = S1.Cells(i, "D")
            Cells(sat, "C") = S1.Cells(i + j + 3, "A")
            Cells(sat, "D") = S1.Cells(i + j + 3, "G")
            Cells(sat, "E") = S1.Cells(i + j + 3, "I")
            Cells(sat, "F") = S1.Cells(i + j + 3, "K")
            Cells(sat, "G") = S1.Cells(i + j + 3, "L")
            sat = sat + 1
        Next j
    Next i
    
End Sub

 

[Hakan ERDOST]

Merhaba,

Deneyiniz.

Sub Aktar()
   
    Dim S1 As Worksheet, i As Long, sat As Long, j As Byte
   
    Set S1 = Sheets("Sayfa1")
   
    Application.ScreenUpdating = False
    Sheets("Sayfa2").Select
    Range("A2:G" & Rows.Count) = ""
   
    sat = 2
    For i = 2 To S1.Cells(Rows.Count, "A").End(xlUp).Row Step 72
        For j = 1 To 4
            Cells(sat, "A") = sat - 1
            Cells(sat, "B") = S1.Cells(i, "D")
            Cells(sat, "C") = S1.Cells(i + j + 3, "A")
            Cells(sat, "D") = S1.Cells(i + j + 3, "G")
            Cells(sat, "E") = S1.Cells(i + j + 3, "I")
            Cells(sat, "F") = S1.Cells(i + j + 3, "K")
            Cells(sat, "G") = S1.Cells(i + j + 3, "L")
            sat = sat + 1
        Next j
    Next i
   
End Sub

Çok teşekkürler Ömer Bey.Bazen kod anlatılıyor ama yazılamıyor.