Sub
ImportVonWordInExcelAusTabelle()
Dim
w
As
Word.Application
Dim
d
As
Word.Document
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
Set
w = CreateObject(
"word.application"
)
w.Visible =
True
w.Documents.Open
"C:\Users\VBA\IDEE 2_mit 2spTabelle.docx"
Set
d = w.ActiveDocument
Worksheets(1).Cells(2, 1).Value = d.Tables(1).Cell(Row:=1, Column:=2)
Worksheets(1).Cells(2, 2).Value = d.Tables(1).Cell(Row:=2, Column:=2)
Worksheets(1).Cells(2, 3).Value = d.Tables(1).Cell(Row:=3, Column:=2)
Worksheets(1).Cells(2, 4).Value = d.Tables(1).Cell(Row:=4, Column:=2)
Worksheets(1).Cells(3, 1).Value = d.Tables(2).Cell(Row:=1, Column:=2)
Worksheets(1).Cells(3, 2).Value = d.Tables(2).Cell(Row:=2, Column:=2)
Worksheets(1).Cells(3, 3).Value = d.Tables(2).Cell(Row:=3, Column:=2)
Worksheets(1).Cells(3, 4).Value = d.Tables(2).Cell(Row:=4, Column:=2)
.
.
.
<strong>
d.Close
False
Set
d =
Nothing
w.Quit
Set
w =
Nothing
Set
ws =
Nothing
End
Sub