Dim xlApp As Excel.Application
Dim SuchRange As Range
Dim AktZelle As Range
Dim intAllWord() as Integer
Dim intWord as Integer
Set xlApp = GetObject(, "Excel.Application")
Set SuchRange = xlApp.Activesheet.Range("D2:D4")
For Each AktZelle In SuchRange
With AktZelle
If Len(.Value) > 0 Then
ReDim Preserve AllWord(iWord)
intAllWord(intWord) = .Value
MsgBox .Value, vbInformation, "Zelle" & .Address
.Value = Replace(.Value, Chr(32), Chr(160))
intWord = intWord + 1
End If
End With
Next