150
Insert Image Size must be less than < 5MB.
150
Top Contributor

## Bring data from columns to row using excel VBA

I have a data in excel sheet in row wise and need to bring in column, so kindly help me on this. please find the below sample input data and how i should get output data.

e.g If the student have 2 subjects then add new rows to update columns data to new row. as given below screen in output data.

 Input Data Sheet Student Name City Class Subject Name Subject Score Raiting English Score English Raiting Maths Score Maths Raiting Science Score Science Raiting JohnÂ Hyderabad 10thÂ 99 A+ 50 C Seema Mumbai 10thÂ 86 A 50 C Gopi Pune 10thÂ 50 C 87 AÂ Rahul Bengaluru 10thÂ 45 C 88 A 50 C Output Data Sheet Student Name City Class Subject Name Subject Score Rating English Score English Rating Math’s Score Math’s Rating Science Score Science Raiting JohnÂ Hyderabad 10thÂ Maths Score 99 A+ JohnÂ Hyderabad 10thÂ Science Score 50 C Seema Mumbai 10thÂ English Score 86 A Seema Mumbai 10thÂ Science Score 50 C Gopi Pune 10thÂ English Score 50 C Gopi Pune 10thÂ Maths Score 87 A+ Rahul Bengaluru 10thÂ English Score 45 C Rahul Bengaluru 10thÂ Maths Score 88 A Rahul Bengaluru 10thÂ Science Score 50 C

Asked by GKJ on April 6, 2018 in VBA.
Expert

Dim lastrow As Integer
Dim lastcol As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim n As Integer
Dim r As Integer
Dim subject As String
Dim i As Integer
Set ws1 = Worksheets(“Sheet1”)
Set ws2 = Worksheets(“Sheet2”)
r = 2
lastrow = Cells(Rows.Count, “A”).End(xlUp).Row
lastcol = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
For n = 1 To lastrow
Cells(r, 4).Select
For i = 1 To 8
If ActiveCell = “” Then
ActiveCell.Offset(0, 1).Select
Else
Range(Cells(r, 1), Cells(r, 4)).Copy
ws2.Cells(Rows.Count, “A”).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

If ActiveCell.Column = “5” Then subject = “Subject”
If ActiveCell.Column = “7” Then subject = “English”
If ActiveCell.Column = “9” Then subject = “Math”
If ActiveCell.Column = “11” Then subject = “Science”
ws2.Cells(Rows.Count, “D”).End(xlUp).Offset(1).Value = subject

Range(ActiveCell, ActiveCell.Offset(0, 1)).Copy
ws2.Cells(Rows.Count, “E”).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

ActiveCell.Offset(0, 2).Select

End If

Next i
r = r + 1
Next n
ws2.Select
Application.CutCopyMode = False
[A1].Select
End Sub

Answered by Hyside2 on April 7, 2018..
• Yes it worked as expected,  and need few more changes that i will make it. thank you so much for your quick help.

on April 9, 2018.
Cancel