PDA

View Full Version : Combine Data in Mutiple Columns into Rows



maytey
01-29-2018, 08:11 PM
My file has multiple columns (Attached is only a sample) and I want to convert the data from column c onwards into the rows.
21478
The results will be as follows:
21479

Can someone please help me with a VBA macro to combine the multiple cloumn data? THanks Much!

georgiboy
01-30-2018, 03:13 AM
Maybe something like:


Sub ReOrder()
Dim rCell As Range, x As Long, endCol As Long
Dim endRow As Long, newRow As Long

endRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row ' set your end row of data
endCol = Range("AU:AU").Column ' set your end column of data
newRow = 2 ' first row of sheet 2

With Sheet2
For x = 1 To endCol - 2
For Each rCell In Sheet1.Range("B2:B" & endRow).Cells
.Cells(newRow, 1).Value = rCell.Offset(, -1).Value
.Cells(newRow, 2).Value = rCell.Value
.Cells(newRow, 3).Value = rCell.Offset(, x).Value
.Cells(newRow, 4).Value = Sheet1.Cells(1, rCell.Offset(, x).Column).Value
newRow = newRow + 1
Next rCell
Next x
End With

End Sub

It restructures the data onto sheet2

Hope this helps

mana
01-30-2018, 06:39 AM
Option Explicit


Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim r As Range
Dim i As Long
Dim n As Long

Set ws1 = Worksheets("Sept-P2")
Set ws2 = Worksheets("Combined")

Set r = ws1.Cells(1).CurrentRegion
Set r = Intersect(r, r.Offset(1))

n = r.Rows.Count

ws1.Cells(1).Resize(, 2).Copy ws2.Cells(1)

For i = 3 To r.Columns.Count
With ws2.Cells(Rows.Count, "a").End(xlUp)
r.Columns("a:b").Copy .Offset(1)
r.Columns(i).Copy .Offset(1, 2)
r.Columns(i).Cells(0).Copy .Offset(1, 3).Resize(n)
End With
Next

End Sub