Excel Macro To Create Rows From Column Data

ColumnToRows.vba

Private Sub NewData_Click()
'Select sheet by name
	Sheets("OriginalData").Select
'Get total rows in column 'a'
	RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
'Select range from K2 to O and clear contents 
	Range("K2:O" & RowCount).Select
	Selection.ClearContents
'Variable to determin a new row
	NewRow = 0
'Loop from second row until end
	For i = 2 To RowCount
'Grab required values and assigned to variables
		Range("A" & i).Select
		ClassName = Range("A" & (ActiveCell.Row)).Value
'If content is empty then finish loop
		If ClassName = "" Then Exit Sub
		YearGroup = Range("B" & (ActiveCell.Row)).Value
		StudentName = Range("C" & (ActiveCell.Row)).Value
		Ver = Range("D" & (ActiveCell.Row)).Value
		Quan = Range("E" & (ActiveCell.Row)).Value
		NVR = Range("F" & (ActiveCell.Row)).Value
		
'Apply values for first column requirement 'Ver' to new cells but increasing row count
		Range("K" & i).Select
		Range("K" & (ActiveCell.Row + NewRow)).Value = ClassName
		Range("L" & i).Select
		Range("L" & (ActiveCell.Row + NewRow)).Value = YearGroup
		Range("M" & i).Select
		Range("M" & (ActiveCell.Row + NewRow)).Value = StudentName
		Range("N" & i).Select
		Range("N" & (ActiveCell.Row + NewRow)).Value = Ver
		Range("O" & i).Select
		Range("O" & (ActiveCell.Row + NewRow)).Value = "Ver"
		
'Apply values for second column requirement 'Quan' to new cells but increasing row count
		Range("K" & i).Select
		Range("K" & (ActiveCell.Row + NewRow + 1)).Value = ClassName
		Range("L" & i).Select
		Range("L" & (ActiveCell.Row + NewRow + 1)).Value = YearGroup
		Range("M" & i).Select
		Range("M" & (ActiveCell.Row + NewRow + 1)).Value = StudentName
		Range("N" & i).Select
		Range("N" & (ActiveCell.Row + NewRow + 1)).Value = Quan
		Range("O" & (ActiveCell.Row + NewRow + 1)).Value = "Quan"
		
'Apply values for first column requirement 'NVR' to new cells but increasing row count
		Range("K" & i).Select
		Range("K" & (ActiveCell.Row + NewRow + 2)).Value = ClassName
		Range("L" & i).Select
		Range("L" & (ActiveCell.Row + NewRow + 2)).Value = YearGroup
		Range("M" & i).Select
		Range("M" & (ActiveCell.Row + NewRow + 2)).Value = StudentName
		Range("N" & i).Select
		Range("N" & (ActiveCell.Row + NewRow + 2)).Value = NVR
		Range("O" & (ActiveCell.Row + NewRow + 2)).Value = "NVR"
		
'Ensure that row count increases correctly so that all columns are converted to new rows
		NewRow = NewRow + 2
	Next
End Sub