Redistribute data from multiple columns into separate rows

[bzenner]

Thank you for this thread, and solution, Rick. Redistribute a Delimited Column Of Data into Separate Rows (Keeping Other Data As Is) (http://www.excelfox.com/forum/f22/redistribute-a-delimited-column-of-data-into-separate-rows-keeping-other-data-as-is-420/)

I have content spanning 20 columns though, it's not delimited within one column. How would I modify the code to make it work for my instance? I'm a novice at this macro stuff, I don't do it often enough. Thanks!
Brad

[Admin]

Hi Welcome to board.

Can you please attach your workbook with expected results ?

[bzenner]

1633 Sorry for the delay, summer vacation for the kids kept me away. I'm looking to take the items in 20 columns and transpose them into 20 rows, so each entry is treated as it's own record. There's two sheets in the workbook attached, one "before" and one "after". I'm sure there's an easy way to modify that original redistibution macro, just not sure how to go about it.

Thanks so much, really appreciated!
Brad

[Admin]

Hi

Try this one.


Option Explicit

Sub kTest()

Dim k, kk(), i As Long, n As Long, c As Long, j As Long

Const TotalColumns As Long = 26
Const StaticColCount As Long = 6

With ThisWorkbook.Worksheets("before")
k = .Range("a1", .Range("a" & .Rows.Count).End(xlUp)).Resize(, TotalColumns).Value2
End With

ReDim kk(1 To UBound(k, 1) * TotalColumns, 1 To StaticColCount + 1)
n = 1
For j = 1 To StaticColCount
kk(n, j) = k(1, j)
Next
For i = 2 To UBound(k, 1)
For c = StaticColCount + 1 To UBound(k, 2)
n = n + 1
For j = 1 To StaticColCount
kk(n, j) = k(i, j)
Next
kk(n, StaticColCount + 1) = k(i, c)
Next
Next

If n Then
With ThisWorkbook.Worksheets("results")
.UsedRange.ClearContents
.Range("a1").Resize(n, UBound(kk, 2)).Value2 = kk
End With
End If

End Sub