Code addition of rows

[olegvolf]

Hello
I have the table of DATA
13 columns
when i run the macro i am chosing the column then the code is unstacking the column to the multiply columns.
I was wondering how can i change the code in order not to choose one column
to make all columns at ones
unstacking each column below other with 4 empty row to dived between them
I attached the file as it working know and the code below

Sub SplitInto15CellsPerColumn()
Dim x As Long, LastRow As Long, vArrIn As Variant, vArrOut As Variant, ct As Long
Sheets("Sheet2").Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row


    
Dim columnnumber As Long
Dim ColumnLetter As String
columnnumber = Application.InputBox _
    (Prompt:="Please enter a column number")
 ColumnLetter = Split(Cells(1, columnnumber).Address, "$")(1)
vArrIn = Range(ColumnLetter & 1 & ":" & ColumnLetter & LastRow)


ReDim vArrOut(1 To 3, 1 To Int(LastRow / 3) + 1)
For x = 0 To LastRow - 1




vArrOut(1 + (x Mod 3), 1 + Int(x / 3)) = vArrIn(x + 1, 1)
Next
Dim n As Integer, MAX As Integer, MIN As Integer
    Dim FinalRow As Long
    With Sheets("Sheet2")
    
 Sheets("Sheet2").Select
With Rows(2)


    LastCol = Cells(.Row, Columns.Count).End(xlToLeft).Column
   ' MsgBox LastCol
   
 ColumnLetter = Split(Cells(1, (LastCol + 1)).Address, "$")(1)
    End With
End With


Range(ColumnLetter & 1).Resize(3, UBound(vArrOut, 2)) = vArrOut




End Sub

SAMPLE.xlsm

Thank you

Oleg

[大灰狼1976]

Hi olegvolf! for example like below.

Private Sub CommandButton1_Click()
Dim arr, i&, r&
arr = [a1].CurrentRegion
r = 2
For i = 1 To UBound(arr, 2)
  Cells(r, 15).Resize(UBound(arr)) = Application.Index(arr, i)
  r = [o65536].End(3).Row + 5
Next i
End Sub

[olegvolf]

Hi
Thank you but the the question was
my code dividing one column into multiply
i need help from the first column to the last
only devided
one below other

[大灰狼1976]

like this?

Sub test()
Dim arr, arr1, i&, j&, r&, c&, r1&, c1&
[n:w].ClearContents
arr = [a1].CurrentRegion
r = UBound(arr, 2) * 7 - 4
c = -Int(-UBound(arr) / 3)
ReDim arr1(1 To r, 1 To c)
For j = 1 To UBound(arr, 2)
  For i = 1 To UBound(arr) Step 3
    r1 = (j - 1) * 7 + 1
    c1 = (i - 1) / 3 + 1
    arr1(r1, c1) = arr(i, j)
    arr1(r1 + 1, c1) = arr(i + 1, j)
    arr1(r1 + 2, c1) = arr(i + 2, j)
  Next i
Next j
[n1].Resize(r, c) = arr1
End Sub