VBA from (multi) column to rows

I often see files built up in columns (week from A to Z)

If you want to use a pivot table it's easier to re-arange the data from columns into rows.

Who can help me with a macro which will do that for me.

In the attached file, also is the desired result.

For the example please post the result in another sheet.

Do you have questions or comments, just ask or comment.

Hi.

Check this macro. I have a sheet "output" where you can verify the final data.

VBA Qeuestion columns to rows Oeldere.xlsm

Thanks jraj1106 and nilem for the code.

I'm gonna work with it at the end of the day.

I will report the result at the end of the day.

@jraj1106

Sub CONVERTROWSTOCOL()
    Dim rsht1 As Long, rsht2 As Long, i As Long, col As Long
   
   With Sheets("output")
    .UsedRange.ClearContents
    .Range("A1:C1").Value = Array("Number", "week", "value")

    End With    
    
    rsht1 = Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row
    rsht2 = Sheets("output").Range("A" & Rows.Count).End(xlUp).Row
    col = 2
    
    For i = 3 To rsht1
        If InStr(1, Sheets("sheet2").Range("A" & i).Value, "TOTAL") > 0 Then
            Exit For
        End If
        Do While Sheets("sheet2").Cells(1, col).Value <> "" And Sheets("sheet2").Cells(i, col).Value <> ""
            rsht2 = rsht2 + 1
            Sheets("output").Range("A" & rsht2).Value = Sheets("sheet2").Range("A" & i).Value
            Sheets("output").Range("B" & rsht2).Value = Sheets("sheet2").Cells(1, col).Value
            Sheets("output").Range("C" & rsht2).Value = Sheets("sheet2").Cells(i, col).Value  'here was .text
            
   '         If Sheets("output").Range("C" & rsht2).Value = 0 Then
   '         Sheets("output").Range("C" & rsht2).Value = "-"
   '         End If
            
            col = col + 1
        Loop
        col = 2
    Next
End Sub

The code is working (and i think i understand most of the code). Thank you for that.

I changed / added the blue text.

I have a question on the red text.
It seems to be the same line twice (or do I read it wrong).

Why is that?

@Nilem

Your code is working perfectly. Thanks for that.

But i'm unable to read (and understand) it well enough, to use it for future use.

May as well post this.

Option Explicit

Sub ToCols()
Dim wsNew As Worksheet
Dim rngSrc As Range
Dim rngDst As Range
Dim rngHeaders As Range

    With Worksheets("Sheet2")
        Set rngSrc = .Range("A3")
        Set rngHeaders = .Range("B1", .Cells(1, Columns.Count).End(xlToLeft))
    End With

    Set wsNew = Worksheets.Add

    Set rngDst = wsNew.Range("A2")

    While rngSrc.Value <> "TOTAL"

        rngDst.Resize(rngHeaders.Columns.Count).Value = rngSrc
        
        rngHeaders.Copy
        rngDst.Offset(, 1).PasteSpecial Transpose:=True
        
        rngSrc.Offset(, 1).Resize(, rngHeaders.Columns.Count).Copy
        rngDst.Offset(, 2).PasteSpecial Transpose:=True
        
        Application.CutCopyMode = False
        
        Set rngSrc = rngSrc.Offset(1)
        Set rngDst = rngDst.Offset(rngHeaders.Columns.Count)
    Wend
    
    wsNew.Range("A1").Resize(, 3).Value = Array("Header1", "Header2", "Header3")
        
End Sub

@Norie,

Couldn't make it that way, but I think i'm able to read (and understand) the code.

Thanks for posting your code.