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)

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]

transpose macro sample.xlsx 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