Excelde yan yana olan verileri alt alta getirme

[gecekusu084]

Merhabalar,
Aşağıdaki örnekteki her sütundaki veriyi. tek bir sütunda alt alta yazmak istiyorum.

Yani tüm verileri A sütununda alt alta getirmek istiyorum bunu nasıl yapabilirim.

	A	B	C	D	E
	640​	221​	219​	764​	138​
	640​	221​	219​	764​	159​
	662​	228​	227​	764​	159​
	679​	228​	227​	774​	160​
	701​	242​	240​	654​	165​
	728​	247​	245​	663​	167​
	765​	247​	245​	672​	169​
	752​	242​	240​	665​	167​
	750​	241​	239​	669​	169​
	750​	246​	244​	694​	174​
	750​	249​	247​	694​	174​
	750​	251​	249​	697​	177​

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu bir modüle kopyalayıp çalıştırın.

Sub VerileriBirSutundaTopla()
    Dim sonSatir As Long
    Dim hedefSatir As Long
    Dim i As Long
    Dim j As Integer
    Dim ws As Worksheet
    
    Set ws = ActiveSheet
    sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    hedefSatir = sonSatir + 1
    
    For j = 2 To ws.UsedRange.Columns.Count
        For i = 1 To sonSatir
            If ws.Cells(i, j).Value <> "" Then
                ws.Cells(hedefSatir, 1).Value = ws.Cells(i, j).Value
                hedefSatir = hedefSatir + 1
            End If
        Next i
    Next j
    
    MsgBox "Veriler başarıyla toplandı!"
End Sub

 

[gecekusu084]

Tam istediğim gibi oldu. Çok teşekkürler

 

[Necdet]

Merhaba, DeepSeek amcanın yanıtı :
A1 :

=EĞERHATA(İNDİS(B$1:F$12; MOD(SATIR()-1; 12)+1; TAMSAYI((SATIR()-1)/12)+1); "")

 

[Necdet]

Makro için de alternatif olsun.

Public Sub Deneme()

Dim rng As Range
Dim i   As Long
Dim j   As Long
Dim sat As Integer

Application.ScreenUpdating = False

Range("A:A").Clear

Set rng = Range("B1").CurrentRegion
sat = rng.Rows.Count

i = 1
For j = 1 To rng.Columns.Count
    rng.Columns(j).Copy Range("A" & i)
    i = i + sat
Next j

Application.ScreenUpdating = False

MsgBox "İşlem  Tamamdır....", vbInformation
End Sub

 

[catalinastrap]

Sub MoveColumnsToColumnA()
Dim ws As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim col As Long
Dim destRow As Long

Set ws = ThisWorkbook.Sheets("Sayfa1")
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
destRow = lastRow + 1

For col = 1 To lastCol
lastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).row
ws.Range(ws.Cells(1, col), ws.Cells(lastRow, col)).Cut Destination:=ws.Cells(destRow, 1)
destRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row + 1
Next col

End Sub

 

[gecekusu084]

Merhaba, DeepSeek amcanın yanıtı :
A1 :

=EĞERHATA(İNDİS(B$1:F$12; MOD(SATIR()-1; 12)+1; TAMSAYI((SATIR()-1)/12)+1); "")

Çok teşekkürler

 

[Korhan Ayhan]

Ofis 365 için alternatifler...

Not : Formüller İngilizce'dir.

=TOCOL(A1:E12;3;1)

=VSTACK(TEXTSPLIT(TEXTJOIN("|";1;A1:E12);;"|"))