How to break one cell values into multiple rows in Macro

How to break one cell values into multiple rows in Macro


Workbook Name: Celltorowconverter.xlsm
Input worksheet Name:Temp
Outputworksheet Name:Result

Below is the code I written to extract the value from Cell to rows:

Sub celltorow()

'---------- declare Variables

Dim Textstring As String
Dim splitVals() As String
Dim totalVals As Integer
Dim Startvals As Integer
Dim i As Integer

'----get the value in Variable

Textstring = ThisWorkbook.Worksheets("Temp").Cells(2, 1).Value

'-----Split the Variable value from new line and stored in array

splitVals() = Split(Textstring, vbNewLine)

'---get the starting and values Array

Startvals = LBound(splitVals())

totalVals = UBound(splitVals())

For i = Startvals + 1 To totalVals
ThisWorkbook.Worksheets("Result").Activate

ThisWorkbook.Worksheets("Result").Range("A" & i).Value = splitVals(i)

Next i

End Sub

Output would be like below: