Satırlardaki verileri sütunlara aktarmak

[programci21]

merhaba arkadaşlar, öncelikle böyle bir sitenin var oluşu biz programcılar açısından çok güzel bir nimet site yöneticelerine teşekkür ederim. ben delphi programlama dilleriylen uğraşıyorum, ama bana a exelde bir makro veya bir kod lazım bana yardımcı olursanız sevinirim.

A1 den A35000 'e kadar alt altta elimde sayılar var. bu sayılara başka bir sayfaya yan yana 10'nar sutunlu halde nasıl dizebilirim. yani Söylemek isdeğim sayfa1 deki alt alta olan A1,A2,A3,A4,A5,A6,A7,A8,A9,A10 hücresindeki verileri sayfa2 ye yanyana yani A1,B1,C1,D2,E1,F1,G1,H1,I,J hücrelerine yazacak, bu konu hakkında bana yardımcı olursanız çok sevinirim. şimdiden tüm arkadaşlara teşekkürler.

 

[Hakan ERDOST]

Sayın programcı21 Excelde 256 sütun vardır. İstediğniz sayıda veriye sütuna dönüştüremezsiniz.

 

[alpi]

Aşağıdaki kodu bir module yazarak çalıştırın

Sub VeriAl()
Dim i As Range
Dim sa As Integer
Dim su As Integer
Dim Say As Long
su = 1
With ThisWorkbook
Say = WorksheetFunction.CountA(.Sheets("Sayfa1").Range("A1:A65500"))
For Each i In .Sheets("Sayfa1").Range("A1:A" & Say)
sa = sa + 1
.Sheets("Sayfa2").Cells(sa, su) = i.Value
If sa = 10 Then
sa = 0
su = su + 1
End If
If su = 257 Then
MsgBox "Alınan veriler sutünlara sığmıyor."
Exit Sub
End If
Next
End With
End Sub

Yukarıdaki kod Sayfa1 in A sutünundaki verileri Sayfa1 e aktarır

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub aktar()
Application.ScreenUpdating = False
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
For a = 1 To s1.[a65536].End(3).Row Step 10
say = WorksheetFunction.CountA(s2.[a:a]) + 1
s1.Range("a" & a & ":a" & a + 9).Copy
s2.Range("a" & say).PasteSpecial , Transpose:=True
Next
Application.CutCopyMode = False
MsgBox "işlem tamamlandı."
End Sub

 

[Mahmut Kök]

bu da istediğiniz işlemi gerçekleştiriyor. Arkadaşlar yazmışlar ama, fikir verebilir.

Sub satır()

Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")

c = 1
For a = 1 To 35000
If b = 10 Then c = c + 1
If b = 10 Then b = 0
b = b + 1

s2.Cells(c, b).Value = s1.Cells(a, 1).Value
If s1.Cells(a, 1) = Empty Then Exit Sub
Next

End Sub