Verileri Hücrelere Dğıtmak

[nailsavas]

Merhaba ekli dosyayı incelermisiniz. Soru dosyanın içerisindedir.İlgilerinize şimdiden teşekkürler

 

[Necdet]

Merhaba,

Sub TersineCevir()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim Bas_Satir, Bit_Satir, Yazdirilacak_Satir, i As Long
Bas_Satir = 2
Yazdirilacak_Satir = 1
s2.Range("A2:C65000").ClearContents
For i = 2 To s1.[C65536].End(3).Row + 1
    If s1.Cells(i, "C") = "" Then
        s1.Range("C" & Bas_Satir & ":C" & i - 1).Copy
        Yazdirilacak_Satir = Yazdirilacak_Satir + 1
        s2.Range("A" & Yazdirilacak_Satir).PasteSpecial Transpose:=True
        Bas_Satir = i + 1
    End If
Next i
MsgBox "İşlem Tamam..."
End Sub