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