Moving Column Into RowsClosed

Question

Hi  

I'm preparing weekly sales report on category sold per shoping chart. There are 100 categories (Category will be header) and all the data extract well be as 'Sheet 1 - Input Data'. The out put of the report should look like 'Sheet2 - OutPut Data'   

The report should be generic in such a way the categories is n  

Sheet 1 - Input Data  

Shoping Cart# Category 1    Category 2   Category 3   Category 4   Category n 10004270       10               100             1000           10000      
10000437       9                 99                                999     
10000234       55555          5555           555                                5  

Sheet2 - OutPut Data  

Shoping Cart#     Category       Value  
10004270           Category 1     10  
10004270           Category 2     100  
10004270           Category 3     1000  
10004270           Category 4     10000  
10000437           Category 1     9  
10000437           Category 2     99  
10000437           Category 4     999  
10000234           Category 1     55555  
10000234           Category 2     5555  
10000234           Category 3     555  
10000234           Category n     5  

I know you guyz are guru in Macros and Excel VB scripting. Please help me in solving this report.   

Kind Regards  
John

venkat1926 · Answer

try this macro
the main data is in sheet 1
the result is in sheet 2

the macro is 

Sub TEST()
Dim r As Range, c As Range, j As Long, k As Long
Dim dest As Range, x(1 To 3) As String, m As Long
Worksheets("sheet2").Cells.Clear
Worksheets("sheet1").Activate
j = Range("A1").End(xlToRight).Column
Set r = Range(Range("A2"), Range("A2").End(xlDown))
For Each c In r
For k = 1 To j - 1
x(1) = Cells(c.Row, 1).Value
x(2) = Cells(1, k + 1).Value
x(3) = Cells(c.Row, k + 1).Value
'MsgBox x(1) & "," & x(2) & "," & x(3)
If Cells(c.Row, k + 1) = "" Then GoTo line1
Set dest = Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Set dest = Range(dest, dest.Offset(0, 2))
dest = x
line1:
Next k
Next c
End Sub

Moving Column Into Rows

1 response

Similar discussions

Subscribe To Our Newsletter!