Hallo Gäbi,
so funktioniert es:
Sub ImportVonWordInExcelAusTabelle()
'Variable definieren
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
'geöffnete Word-Vorlage als aktives Dokument kennzeichnen
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
'word öffnen
'w.Documents.Open "C:\Users\VBA\IDEE 2_mit 2spTabelle.docx"
'dokument aktivieren, 1. Tabelle: Parameter finden und exportieren
Set d = w.ActiveDocument
' Letzte Zeile in Tabelle 1 ermitteln
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
'i = ws.Cells(ws.Cells.Rows.Count, 1).End(xlUp).Row + 1
'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)
'nächste Tabelle
'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>'mache das, bis keine neue Tabelle mehr vorhanden ist</strong>
d.Close False
Set d = Nothing
w.Quit
Set w = Nothing
Set ws = Nothing
End Sub
Wenn das Range.Text Inhalt aus Word komplett übernommen wird, wird in Excel 2021 immer ein Steuerzeichen am Ende mit eingefügt. Daher wurde vor dem Einfügen das letzte Zeichen immer abgeschnitten. Falls das Verhalten in Excel 365 anders sollte, kann direkt
Worksheets(1).Cells(xlTbl, xlCol).Value = tblRow.Cells(2).Range.Text
verwendet werden.
|