1. isteğiniz dikey yapma kodu
Function VeriDikey()
Set Syf = ThisWorkbook.Worksheets("sayfa1")
With Syf
'.Range("A:A").ClearContents
lr = .Cells(Syf.Rows.Count, "G").End(xlUp).Row
xDzK = .Range("G3:P" & lr).Value2
Dim xDzH As Variant
xByt = UBound(xDzK, 1) * UBound(xDzK, 2)
ReDim xDzH(1 To xByt, 0)
For xStr = 1 To UBound(xDzK, 1)
For xStn = 1 To UBound(xDzK, 2)
' Debug.Print xDzK(xStr, xStn)
d = d + 1
xDzH(d, 0) = xDzK(xStr, xStn)
Next xStn
Next xStr
.Range("A3:A" & 2 + xByt) = xDzH
'.Range("G3:P" & lr).ClearContents
End With
End Function
2. isteğiniz yan yana 10arlı liste
Function VeriRange()
Set Syf = ThisWorkbook.Worksheets("sayfa1")
With Syf
lr = .Cells(Syf.Rows.Count, "A").End(xlUp).Row
xDzK = .Range("A3:A" & lr).Value2
Dim xDzH As Variant
xStrSay = Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count 'Int(UBound(xDzK, 1) / 10) '+ 1
ReDim xDzH(0 To xStrSay, 9)
For x = 0 To UBound(xDzK, 1) - 1
If Len(xDzK(x + 1, 1) & "") <> 0 Then
xStn = y Mod 10
xStr = (y \ 10)
xDzH(xStr, xStn) = xDzK(x + 1, 1)
y = y + 1
End If
Next x
.Range("G3:P" & 3 + xStrSay) = xDzH
End With
End Function