Bir sütunda alt alta yazılı olanları Sütunlara bölme

[u.L.a.s]

Merhabalar

A sütununda 3000 e yakın verim var.

A sütununda ilk 47 satır kalacak şekilde sonrasındaki satırlarda bulunan verileri 47 satır halinde B sütununa C sütununa D sütununa E sütununa F Sütununa G Sütununa H sütununa dağıtmam gerekiyor. böylelikle 376 veriyi yanyana getirmiş olacağım. sonrasında A sütununda kalan diğer verileri yine aynı mantıkla bu sefer 48. satırdan başlayarak yien 47 satır halinde A,B,C,D,E,F,G,H sütunlarına bölmüş olacak

Veriler bitene kadar böyle devam edecek. bilgi ve yardımınızı rica ederim

 

[u.L.a.s]

Eğer bu zor olacaksa en basidinden 47 Satır halinde sütunlara bölelim. yani H sütununda bitmesin devam etsin her 47 satır bir yan sütuna bir sonraki 47 satır bir sonraki sütuna yazılacak şekilde

 

[Korhan Ayhan]

Merhaba,

Verilerinizi YEDEKLEYEREK aşağıdaki kodu deneyiniz.

Option Explicit

Sub Verileri_Bolerek_Yana_Aktar()
    Dim S1 As Worksheet, Veri As Variant, X As Long, Son As Long, Sutun As Integer, Y As Integer, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("Sheet1")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    Veri = S1.Range("A1:A" & Son).Value2
    
    ReDim Liste(1 To 47, 1 To Columns.Count)
    
    Sutun = 1
    
    For X = LBound(Veri) To UBound(Veri) Step 47
        For Y = 1 To 47
            If (Y + X - 1) > UBound(Veri) Then GoTo 10
            Liste(Y, Sutun) = Veri(Y + X - 1, 1)
        Next
        Sutun = Sutun + 1
    Next
    
10
    S1.Range("A1").Resize(S1.Rows.Count, S1.Columns.Count).ClearContents
    S1.Range("A1").Resize(47, Sutun) = Liste
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

 

[u.L.a.s]

Korhan Ayhan Üstadım emeğine bilgine sağlık çok teşekkür ederim