PDA

View Full Version : Code addition of rows



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

大灰狼1976
12-26-2018, 02:12 AM
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
12-26-2018, 02:17 AM
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
12-26-2018, 06:48 PM
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