Sub
ImportVonWordInExcelAusTabelle()
Dim
w
As
Word.Application
Dim
d
As
Word.Document
Dim
tbl
As
Word.Table, tblRow
As
Word.Row
Dim
xlTbl
As
Integer
, xlCol
As
Integer
Dim
ws
As
Worksheet
Dim
i
As
Long
Set
ws = ActiveSheet
On
Error
Resume
Next
Set
w = GetObject(
"word.application"
)
If
Err.Number <> 0
Then
Set
w = CreateObject(Word.Application)
Err.Clear
End
If
Set
w = CreateObject(
"word.application"
)
w.Visible =
True
Set
d = w.ActiveDocument
xlTbl = (Worksheets(1).UsedRange.Rows.Count - 1) + Worksheets(1).UsedRange.Row
For
Each
tbl
In
d.Tables
xlTbl = xlTbl + 1
xlCol = 0
For
Each
tblRow
In
tbl.Rows
xlCol = xlCol + 1
Worksheets(1).Cells(xlTbl, xlCol).Value = Left(tblRow.Cells(2).Range.Text, Len(tblRow.Cells(2).Range.Text) - 1)
Next
Next
d.Close
False
Set
d =
Nothing
w.Quit
Set
w =
Nothing
Set
ws =
Nothing
End
Sub