format değiştirerek kopyala yapıştır makrosu

[alialiyilmazali]

merhabalar,
eski formattaki verileri yeni bir formata dönüştürmek istiyorum. veri sayısı fazla olduğu için bir makroya ihtiyacım var.
eski ve yeni formatı koydum aslında basit bir copy-paste olayı gibi görünüyor ama yardımcı olursanız sevinirim.

 

[Korhan Ayhan]

Selamlar,

Forumumuza hoşgeldiniz.

Aşağıdaki kodu kullanabilirsiniz.

Option Explicit
 
Sub SORULARI_DÜZENLE()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Satır As Long, Y As Byte
    
    Set S1 = Sheets("OLD")
    Set S2 = Sheets("NEW")
        
    Application.ScreenUpdating = False
    
    S2.Cells.Clear
    Satır = 3
    
    For X = 2 To S1.Range("A65536").End(3).Row
        S2.Cells(Satır, 1) = X - 1
        S2.Rows(Satır).Interior.ColorIndex = 8
        S2.Cells(Satır, 4) = S1.Cells(X, 1)
        S2.Range("C" & Satır + 1 & ":C" & Satır + 5).Value = Application.Transpose(S1.Range("B1:F1").Value)
        S2.Range("D" & Satır + 1 & ":D" & Satır + 5).Value = Application.Transpose(S1.Range("B" & X & ":F" & X).Value)
        S2.Range("D" & Satır + 1 & ":D" & Satır + 5).Interior.ColorIndex = 15
        
        For Y = Satır + 1 To Satır + 5
            If S1.Cells(X, 7) = S2.Cells(Y, 3) Then
                S2.Cells(Y, 2) = "X"
                Exit For
            End If
        Next
        
        Satır = Satır + 7
    Next
    S2.Select
    Cells.EntireColumn.AutoFit
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ynmcan]

Syn. Alialiyilmazali ;
Alternatif olarak ekteki örnek dosyayı inceleyin.