VBA - Copy Each Columns Data in Row

[unknownymous]

Hi Guys,

I have this data below but what i need is to produce the data in list form


Before:

ID	RANK	NAME	NOTE1	NOTE2	1/30/2018	8/30/2017	5/30/2017	4/30/2017	1/30/2017
01	1	Ben			500	450	300	250	200
02	2	Sam			450	425	275	225	175
03	3	Max			425	400	250	0	0

<tbody>
</tbody>

Result: Will be exported in another sheet named "Results"

Date	Score
1/30/2018	500
1/30/2018	450
1/30/2018	425
8/30/2017	450
8/30/2017	425
8/30/2017	400
5/30/2017	300
5/30/2017	275
5/30/2017	250
4/30/2017	250
4/30/2017	225
4/30/2017	200
1/30/2017	200
1/30/2017	175
1/30/2017	150

<tbody>
</tbody>

Note that the data might be have additional dates and numbers might be more (set as until row 10K for each column). Lastly, all zero will be deleted.


Any help will be much appreciated.

 

[SteveO59L]

something along the lines of

Dim c As Range, rng
Dim lr As Long

Set rng = Range("f2:j4")
For Each c In rng
lr = Range("o" & Rows.Count).End(xlUp).Row + 1
Range("o" & lr) = c.Value
Range("n" & lr) = Cells(1, c.Column).Value
Next c

 

[unknownymous]

Amazing! Thank you