Multiple rows to single rows

Hello

I have questions,

I have code to transpose multiple rows into single rows, it not 100% work,

Sub splitthem()
Dim Rng As Range, Dn As Range, ray(), Txt As String, t
Set Rng = Range(Range("A3"), Range("A" & Rows.Count).End(xlUp))
For Each Dn In Rng
    If Not temp = Dn And Dn <> "" Then
        Set temp = Dn
        c = c + 1
    End If
    ReDim Preserve ray(1 To 2, 1 To c)
    ray(1, c) = temp: ray(2, c) = ray(2, c) & " " & Dn.Offset(, 1).Value
Next Dn
Range("G1").Resize(c, 2) = Application.Transpose(ray)
End Sub

as there are at least two problem:
1. the result is in single cell separate by comma, i need the result in separate column
2. the last data not show properly, in example, the letter G is not show up.

Would be great if you can review what's wrong with the code.

sample file attached.

Thank you for the help.