Convert row one into three column

Closed
Vijay - Jun 20, 2012 at 04:23 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Jun 20, 2012 at 10:31 PM
Dear friends,

Could you please help me to convert below given data into required format
Current situation
12345 60
12345 50
12345 40
12435 60
12435 40
12435 50
Requirement
12345 40 50 60
12435 40 50 60 please do the needful

1 response

venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jun 20, 2012 at 10:31 PM
see attached file "vijay.xls" which can be downloaded from
http://speedy.sh/37QbQ/vijy.xls

the macro is in the module repeated here



Sub test()
Dim r As Range, unq As Range, cunq As Range, filt As Range, r1 As Range
Dim rdelete As Range, dest As Range, item, amt As Long
Range(Range("a1").End(xlDown).Offset(1, 0), Cells(Rows.Count, "A")).EntireRow.Delete
Range(Range("G2"), Range("G2").End(xlToRight)).EntireColumn.Delete

Set r = Range("a1").CurrentRegion

Set r1 = r.Resize(, r.Columns.Count - 1)
'MsgBox r1.Address
Set unq = Range("a1").End(xlDown).Offset(5, 0)
r1.AdvancedFilter xlFilterCopy, , unq, True
Set unq = Range(unq.Offset(1, 0), unq.End(xlDown))
For Each cunq In unq
item = cunq.Value
r.AutoFilter 1, cunq.Value


Set dest = Cells(Rows.Count, "g").End(xlUp).Offset(1, 0)

'MsgBox dest.Address
dest = item
Range(Range("B2"), Range("B2").End(xlDown)).SpecialCells(12).Copy

dest.Offset(0, 1).PasteSpecial Transpose:=True
ActiveSheet.AutoFilterMode = False
Next cunq



End Sub
0