Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Werte aus Word Tabelle in Excel einfügen
04.07.2023 07:24:38 Sebastian
Solved

Ansicht des Beitrags:
Von:
Sebastian
Datum:
04.07.2023 07:24:38
Views:
800
Rating: Antwort:
 Nein
Thema:
VBA Werte aus Word Tabelle in Excel einfügen

Hallo!

Ich verwende bisher diesen Code um mehrere Tabellen einer Word Datei in Excel zu importieren. Das gute daran, die Sturktur der Tabelle bleibt erhalten. Schlecht ist aber, dass unzähliche Striche und Objekte mitkopiert werden. Ich möchte eigentlich nur die Werte der Tabelle kopieren. Mit Lösungen wie paste als "Text" oder diese Dinge, habe ich das Problem dass mir die Tabelle einfach in der Spalte A nach unten hin reinkopiert werden, also die Tabelle verliert ihre Struktur. Habt ihr eventuell eine Lösung? Danke!

 

'Word öffnen und kopieren und einfügen Dim wb As Workbook Dim sh As Worksheet Set wb = ActiveWorkbook 'Set sh = wb.ActiveSheet Set sh = wb.Sheets("ZV_Umrechnung_P5000") Dim Btxt As Object Set Btxt = CreateObject("Word.Application") Btxt.Visible = False Btxt.Documents.Open word_path Application.Wait Now + TimeValue("0:00:01") If Left(Btxt.ActiveDocument.Tables(1).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Art" And Left(Btxt.ActiveDocument.Tables(1).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Ges" Then Btxt.ActiveDocument.Tables(1).Range.Copy Application.GoTo sh.Cells(Rows.Count, 1).End(xlUp).Offset(1) sh.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False If Left(Btxt.ActiveDocument.Tables(2).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Art" And Left(Btxt.ActiveDocument.Tables(2).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Ges" Then Btxt.ActiveDocument.Tables(2).Range.Copy 'Application.Goto sh.Cells(60, 1) Application.GoTo sh.Cells(Rows.Count, 1).End(xlUp).Offset(1) sh.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False If Left(Btxt.ActiveDocument.Tables(3).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Art" And Left(Btxt.ActiveDocument.Tables(3).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Ges" Then Btxt.ActiveDocument.Tables(3).Range.Copy 'Application.Goto sh.Cells(100, 1) Application.GoTo sh.Cells(Rows.Count, 1).End(xlUp).Offset(1) sh.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False If Left(Btxt.ActiveDocument.Tables(4).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Art" And Left(Btxt.ActiveDocument.Tables(4).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Ges" Then Btxt.ActiveDocument.Tables(4).Range.Copy 'Application.Goto sh.Cells(150, 1) Application.GoTo sh.Cells(Rows.Count, 1).End(xlUp).Offset(1) sh.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False If Left(Btxt.ActiveDocument.Tables(5).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Art" And Left(Btxt.ActiveDocument.Tables(5).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Ges" Then Btxt.ActiveDocument.Tables(5).Range.Copy 'Application.Goto sh.Cells(150, 1) Application.GoTo sh.Cells(Rows.Count, 1).End(xlUp).Offset(1) sh.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False If Left(Btxt.ActiveDocument.Tables(6).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Art" And Left(Btxt.ActiveDocument.Tables(6).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Ges" Then Btxt.ActiveDocument.Tables(6).Range.Copy 'Application.Goto sh.Cells(150, 1) Application.GoTo sh.Cells(Rows.Count, 1).End(xlUp).Offset(1) sh.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False If Left(Btxt.ActiveDocument.Tables(7).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Art" And Left(Btxt.ActiveDocument.Tables(7).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Ges" Then Btxt.ActiveDocument.Tables(7).Range.Copy 'Application.Goto sh.Cells(150, 1) Application.GoTo sh.Cells(Rows.Count, 1).End(xlUp).Offset(1) sh.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False If Left(Btxt.ActiveDocument.Tables(8).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Art" And Left(Btxt.ActiveDocument.Tables(8).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Ges" Then Btxt.ActiveDocument.Tables(8).Range.Copy 'Application.Goto sh.Cells(150, 1) Application.GoTo sh.Cells(Rows.Count, 1).End(xlUp).Offset(1) sh.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False If Left(Btxt.ActiveDocument.Tables(9).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Art" And Left(Btxt.ActiveDocument.Tables(9).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Ges" Then Btxt.ActiveDocument.Tables(9).Range.Copy 'Application.Goto sh.Cells(150, 1) Application.GoTo sh.Cells(Rows.Count, 1).End(xlUp).Offset(1) sh.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False If Left(Btxt.ActiveDocument.Tables(10).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Art" And Left(Btxt.ActiveDocument.Tables(10).Cell(Row:=1, Column:=1).Range.Text, 3) <> "Ges" Then Btxt.ActiveDocument.Tables(10).Range.Copy 'Application.Goto sh.Cells(150, 1) Application.GoTo sh.Cells(Rows.Count, 1).End(xlUp).Offset(1) sh.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False End If End If End If End If End If End If End If End If End If End If Application.CutCopyMode = False Btxt.Documents(word_path).Close SaveChanges:=False Btxt.Quit Set Btxt = Nothing Set wb = Nothing Set sh = Nothing

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Werte aus Word Tabelle in Excel einfügen
04.07.2023 07:24:38 Sebastian
Solved