Sub testWord2Excel()
Dim objWd As Object, i
'ici adapter le chemin et le nom du fichier Word
Set objWd = GetObject("C:\temp\test.doc")
With objWd.ActiveWindow.Selection
.WholeStory
.Copy
End With
Range("A1").PasteSpecial xlPasteValues
For i = 1 To Len(Range("A1").Text)
Cells(i, 2) = Mid(Range("A1").Text, i, 1)
Next i
Columns(1).Delete
End Sub