Sub Test()
    Dim a, i As Long, ii As Long
    Columns("D:E").ClearContents
    a = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim b(1 To Application.WorksheetFunction.Even(UBound(a)), 1 To 2)
    For i = LBound(b) To UBound(b) Step 2
        ii = ii + 1
        b(ii, 1) = a(i, 1)
        On Error Resume Next
            b(ii, 2) = a(i + 1, 1)
        On Error GoTo 0
    Next i
    Range("D1").Resize(ii, UBound(b, 2)).Value = b
End Sub