Satırları sütunlara listelemek

[Korhan Ayhan]

Selamlar,

Ekteki dosyada sayfa1 deki bilgileri sayfa2 deki formata dönüştürmek istiyorum.

 

[Ayhan Ercan]

selam. biraz cabuk ve acele ile birlikte bişey yaptım. ama uzman arakdaşlar daha da pratik bişey bulacaklardır. umarım işinizi görecektir.

Sub deneme()
Set s1 = Worksheets("Sayfa1")
Set s2 = Worksheets("Sayfa2")
For i = 1 To 4
s2.Cells(i, 1).Value = s1.Cells(2, i)
s2.Cells(i, 3).Value = s1.Cells(3, i)
s2.Cells(i, 5).Value = s1.Cells(4, i)
s2.Cells(i + 5, 1).Value = s1.Cells(5, i)
s2.Cells(i + 5, 3).Value = s1.Cells(6, i)
s2.Cells(i + 5, 5).Value = s1.Cells(7, i)
s2.Cells(i + 10, 1).Value = s1.Cells(8, i)
s2.Cells(i + 10, 3).Value = s1.Cells(9, i)
s2.Cells(i + 10, 5).Value = s1.Cells(10, i)
s2.Cells(i + 15, 1).Value = s1.Cells(11, i)
Next i
End Sub

 

[dost]

Merhaba

[vb:1:c3f3b33844]
Sub listele()
sut = Sheets("Sayfa1").Range("A1").End(xlToRight).Column
sat = Sheets("Sayfa1").Range("A1").End(xlDown).Row
yazsat = 1: yazsut = 1
For i = 2 To sat
For y = 1 To sut
Sheets("Sayfa2").Cells(yazsat, yazsut) = Sheets("Sayfa1").Cells(i, y)
yazsat = yazsat + 1
Next y
yazsut = yazsut + 2
If yazsut > 5 Then
yazsut = 1
yazsat = yazsat + 1
Else: yazsat = yazsat - 4
End If
Next i
End Sub
[/vb:1:c3f3b33844]

 

[Korhan Ayhan]

Selamlar,

Sn. dost ilginiz için çok teşekkür ederim. :arkadas: