yanyana sutunları alt alta alma

[burculuburculu]

Merhaba arkadaşlar,

Elimde bir excel dokumanı var. Yaklaşık 100 adet sutunda var her sutunda 5,6 tane satır var.

Örneğin A sutunu:

book
pencil
paper
kitap

B sutunu

meat
cook
drink
yemek


Ben bu şekilde 100 tane sutunu altalta almak istiyorum yani hepsi A sutunun altına gelsin istiyorum. Bu nasıl mumkun olur. Özel yapıştır ters çeviri denedim fakat olmadı. tek satıra yanyana aldı bu sefer. Başka bir yolu var mıdır?


Yani A sutunu
book
pencil
paper
kitap
meat
cook
drink
yemek


bu şekilde devam etmeli.

Yardımlarınız için şimdiden teşekkürler.

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp dener misiniz?

Sub TekSutuna()

    Dim i       As Long, _
        aSat    As Long, _
        kSat    As Long, _
        j As Integer, _
        k       As Integer
    
    k = Cells.Find("*", , , , xlByColumns, xlPrevious).Column

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    For j = 2 To k
        aSat = Cells(Rows.Count, "A").End(3).Row + 1
        kSat = Cells(Rows.Count, j).End(3).Row
        Range(Cells(1, j), Cells(kSat, j)).Cut Cells(aSat, "A")
    Next j
    
    Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
End Sub

 

[veyselemre]

Sub test()
    sat = 1
    For Each huc In ActiveSheet.UsedRange.Columns
        son = Cells(Rows.Count, huc.Column).End(3).Row
        With Cells(1, huc.Column)
            If .Value <> "" Then
                Range(.Cells, Cells(son, huc.Column)).Cut Cells(sat, 1)
                sat = Cells(Rows.Count, 1).End(3).Row + 1
            End If
        End With
    Next huc
End Sub

 

[burculuburculu]

size minnettarım çok teşekkürler. Her şey gönlünüzce olsun Mutlu sağlıklı huzurlu bir dünya ve öbür dünya dilerim inşallah