Data Available on Rows need to be presented on Columns

[aksan782]

I have huge data which are in multiple rows. But i want those data's to be represented in Columns. I have enclosed a sample document which represents the Master Data format and also the expected resulted im looking for.

Thanks in advance for your help on this. Much Appreciated.

Regards,

Anand

 

[chirayu]

Sub Transposer()

Dim MyVal As String

Worksheets("Master Data").Select
Range("A2").Select

Do Until IsEmpty(ActiveCell)
    MyVal = ActiveCell.Value
    Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1).End(xlToRight)).Copy
    Worksheets("Expected Result Format").Select
    Range("B" & Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row).Select
    ActiveCell.Offset(0, -1).Value = MyVal
    Selection.PasteSpecial Transpose:=True
    Worksheets("Master Data").Select
    ActiveCell.Offset(1, 0).Select
Loop

End Sub

 

[aksan782]

Thanks. I did face some problem in getting the exact data as i think i have not provided the actual scenario of the master data. I'm enclosing the updated Master data on which i have add additional Row's (highlighted in yellow).

Sorry for not being clear on the first instance.

Much Appreciated.

 

[chirayu]

explanations of code also added. assumes you only have contact names from columns B to G

Sub Transposer()

Dim MyVal As String 'Contact Group

Worksheets("Master Data").Select
Range("A2").Select

Do Until IsEmpty(ActiveCell)

    'Copy Contact Group
    MyVal = ActiveCell.Value
   
    'Copy Contact Names - change ":G" if you increase number of contact name columns
    Range("B" & ActiveCell.Row & ":G" & ActiveCell.Row).Copy
   
    'Paste in Expected Result Format sheet
    Worksheets("Expected Result Format").Select
    Range("B" & Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row).Select
    ActiveCell.Offset(0, -1).Value = MyVal
    Selection.PasteSpecial Transpose:=True
   
    'Go back to Master Data sheet, next row, to continue working
    Worksheets("Master Data").Select
    ActiveCell.Offset(1, 0).Select

Loop

End Sub

 

[aksan782]

Thanks a lot for your help. Im getting my expected result.