Redistribute data from multiple columns into separate rows

Thank you for this thread, and solution, Rick. Redistribute a Delimited Column Of Data into Separate Rows (Keeping Other Data As Is)

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

Hi Welcome to board.

Can you please attach your workbook with expected results ?

Attachment 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

Hi

Try this one.

Code:

---

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

---