olegvolf
12-26-2018, 01:46 AM
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
23467
Thank you
Oleg
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
23467
Thank you
Oleg