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:

[TABLE="width: 500"]
<tbody>[TR]
[TD]ID[/TD]
[TD]RANK[/TD]
[TD]NAME[/TD]
[TD]NOTE1[/TD]
[TD]NOTE2[/TD]
[TD]1/30/2018[/TD]
[TD]8/30/2017[/TD]
[TD]5/30/2017[/TD]
[TD]4/30/2017[/TD]
[TD]1/30/2017[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]01[/TD]
[TD]1[/TD]
[TD]Ben[/TD]
[TD][/TD]
[TD][/TD]
[TD]500[/TD]
[TD]450[/TD]
[TD]300[/TD]
[TD]250[/TD]
[TD]200[/TD]
[/TR]
[TR]
[TD]02[/TD]
[TD]2[/TD]
[TD]Sam[/TD]
[TD][/TD]
[TD][/TD]
[TD]450[/TD]
[TD]425[/TD]
[TD]275[/TD]
[TD]225[/TD]
[TD]175[/TD]
[/TR]
[TR]
[TD]03[/TD]
[TD]3[/TD]
[TD]Max[/TD]
[TD][/TD]
[TD][/TD]
[TD]425[/TD]
[TD]400[/TD]
[TD]250[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


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

[TABLE="width: 500"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Score[/TD]
[/TR]
[TR]
[TD]1/30/2018[/TD]
[TD]500[/TD]
[/TR]
[TR]
[TD]1/30/2018[/TD]
[TD]450[/TD]
[/TR]
[TR]
[TD]1/30/2018[/TD]
[TD]425[/TD]
[/TR]
[TR]
[TD]8/30/2017[/TD]
[TD]450[/TD]
[/TR]
[TR]
[TD]8/30/2017[/TD]
[TD]425[/TD]
[/TR]
[TR]
[TD]8/30/2017[/TD]
[TD]400[/TD]
[/TR]
[TR]
[TD]5/30/2017[/TD]
[TD]300[/TD]
[/TR]
[TR]
[TD]5/30/2017[/TD]
[TD]275[/TD]
[/TR]
[TR]
[TD]5/30/2017[/TD]
[TD]250[/TD]
[/TR]
[TR]
[TD]4/30/2017[/TD]
[TD]250[/TD]
[/TR]
[TR]
[TD]4/30/2017[/TD]
[TD]225[/TD]
[/TR]
[TR]
[TD]4/30/2017[/TD]
[TD]200[/TD]
[/TR]
[TR]
[TD]1/30/2017[/TD]
[TD]200[/TD]
[/TR]
[TR]
[TD]1/30/2017[/TD]
[TD]175[/TD]
[/TR]
[TR]
[TD]1/30/2017[/TD]
[TD]150[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


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