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