E-okul'dan Excel'e not aktarma

Sub DuzenleTumSheetler()
    Dim wsMevcut As Worksheet
    Dim wsYeni As Worksheet
    Dim ogrenciNo As String
    Dim adSoyad As String
    Dim sinav1 As String
    Dim sinav2 As String
    Dim satirMevcut As Long
    Dim satirYeni As Long
    Dim yeniSheetAdi As String
    
    Application.ScreenUpdating = False ' Performans için ekran güncellemeyi kapat
    
    ' Çalışma kitabındaki tüm sheet'leri döngüye al
    For Each wsMevcut In ThisWorkbook.Sheets
        ' Yeni sheet adı belirle
        yeniSheetAdi = wsMevcut.Name & " - Düzenlenmiş"
        
        ' Zaten böyle bir sheet varsa onu atla
        On Error Resume Next
        Set wsYeni = ThisWorkbook.Sheets(yeniSheetAdi)
        On Error GoTo 0
        If Not wsYeni Is Nothing Then
            Set wsYeni = Nothing
            GoTo SonrakiSheet
        End If
        
        ' Yeni sheet oluştur
        Set wsYeni = ThisWorkbook.Sheets.Add
        wsYeni.Name = yeniSheetAdi
        
        ' Yeni sheet'te başlıklar
        wsYeni.Cells(1, 1).Value = "Numara"
        wsYeni.Cells(1, 2).Value = "Ad Soyad"
        wsYeni.Cells(1, 3).Value = "1. Sınav"
        wsYeni.Cells(1, 4).Value = "2. Sınav"
        
        ' Mevcut sheet'teki verileri işleme
        satirMevcut = 1
        satirYeni = 2 ' Yeni sheet'teki yazma başlangıç satırı
        
        Do While wsMevcut.Cells(satirMevcut, 1).Value <> ""
            ogrenciNo = wsMevcut.Cells(satirMevcut, 1).Value
            adSoyad = wsMevcut.Cells(satirMevcut, 2).Value
            sinav1 = wsMevcut.Cells(satirMevcut + 1, 3).Value
            sinav2 = wsMevcut.Cells(satirMevcut + 1, 4).Value
            
            ' Yeni sheet'e verileri yaz
            wsYeni.Cells(satirYeni, 1).Value = ogrenciNo
            wsYeni.Cells(satirYeni, 2).Value = adSoyad
            wsYeni.Cells(satirYeni, 3).Value = sinav1
            wsYeni.Cells(satirYeni, 4).Value = sinav2
            
            ' Satırları ilerlet
            satirMevcut = satirMevcut + 2
            satirYeni = satirYeni + 1
        Loop
        
SonrakiSheet:
        ' Bir sonraki sheet'e geçmeden önce wsYeni değişkenini sıfırla
        Set wsYeni = Nothing
    Next wsMevcut
    
    Application.ScreenUpdating = True ' Ekran güncellemeyi geri aç
    MsgBox "Tüm sheet'ler düzenlendi ve yeni sheet'lere aktarıldı!", vbInformation
End Sub

Sub DuzenleOgrenciNotlariBirlesik()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim rowTarget As Long
    
    ' Aktif sayfayı kaynak olarak belirle
    Set wsSource = ThisWorkbook.ActiveSheet
    
    ' Yeni bir sayfa oluştur ve hedef olarak belirle
    Set wsTarget = ThisWorkbook.Sheets.Add
    wsTarget.Name = "Duzenlenmis Notlar"
    
    ' Başlıkları yeni sayfaya yaz
    wsTarget.Cells(1, 1).Value = "Numara"
    wsTarget.Cells(1, 2).Value = "Ad Soyad"
    wsTarget.Cells(1, 3).Value = "1. Yazılı"
    wsTarget.Cells(1, 4).Value = "1. Dinleme"
    wsTarget.Cells(1, 5).Value = "1. Konuşma"
    wsTarget.Cells(1, 6).Value = "1. Ort."
    wsTarget.Cells(1, 7).Value = "2. Yazılı"
    wsTarget.Cells(1, 8).Value = "2. Dinleme"
    wsTarget.Cells(1, 9).Value = "2. Konuşma"
    wsTarget.Cells(1, 10).Value = "2. Ort."
    
    ' Son satırı bul
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    rowTarget = 2 ' Yeni sayfada yazmaya başlanacak satır
    
    ' Öğrenci bilgilerini tek satıra yaz
    i = 1 ' İlk öğrencinin verisi A1 hücresinden başlıyor
    Do While i <= lastRow
        If wsSource.Cells(i, 1).MergeCells Then
            ' Birleşik hücrelerden numara ve ad soyad al
            wsTarget.Cells(rowTarget, 1).Value = wsSource.Cells(i, 1).Value ' Numara
            wsTarget.Cells(rowTarget, 2).Value = wsSource.Cells(i, 2).Value ' Ad Soyad
            
            ' Notları al ve yaz
            wsTarget.Cells(rowTarget, 3).Value = wsSource.Cells(i + 1, 3).Value ' 1. Yazılı
            wsTarget.Cells(rowTarget, 4).Value = wsSource.Cells(i + 1, 4).Value ' 1. Dinleme
            wsTarget.Cells(rowTarget, 5).Value = wsSource.Cells(i + 1, 5).Value ' 1. Konuşma
            wsTarget.Cells(rowTarget, 6).Value = wsSource.Cells(i + 1, 6).Value ' 1. Ort.
            wsTarget.Cells(rowTarget, 7).Value = wsSource.Cells(i + 1, 7).Value ' 2. Yazılı
            wsTarget.Cells(rowTarget, 8).Value = wsSource.Cells(i + 1, 8).Value ' 2. Dinleme
            wsTarget.Cells(rowTarget, 9).Value = wsSource.Cells(i + 1, 9).Value ' 2. Konuşma
            wsTarget.Cells(rowTarget, 10).Value = wsSource.Cells(i + 1, 10).Value ' 2. Ort.
            
            rowTarget = rowTarget + 1
        End If
        i = i + 2 ' Her öğrencinin bilgileri iki satırda bir geliyor
    Loop
    
    MsgBox "Öğrenci notları yeni sayfaya başarıyla aktarıldı!", vbInformation
End Sub