Probleme beim Kopieren Word Tabelle nach Excel

Hallo Experten,
ich habe im Forum folgende Frage gefunden, die mich auch interessiert, weiß darauf wirklich keiner eine Antwort?
Gruß OS
* Probleme beim Kopieren Word Tabelle nach Excel von Achim vom 30.11.2004 14:53:07
Beim Kopieren von Word Tabellen nach Excel (Office 97) kann ich folgendes Problem leider nicht lösen:
Zellen der Word Tabelle, die Zeilenumbrüche besitzen, werden in Excel auf mehrere Zellen verteilt. Ich möchte jedoch, dass in Excel die Zeilenumbrüche aus Word auch in der Excel-Zelle erhalten bleiben. Eine Lösung wäre Zelle für Zelle kopiert. Dies ist nicht praktikabel, da ich große Datenmengen zu bearbeiten habe.
Wer kann mir bitte mit einer einfachen Lösung helfen. Vielen Dank im Voraus!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub WordNachExcel() Dim objWordApp As Word.Application Dim objWordDok As Word.Document Dim A As Long Dim strText As Variant Set objWordApp = New Word.Application objWordApp.Visible = True Set objWordDok = objWordApp.Documents.Open(ThisWorkbook.Path & "\Dok1.doc") For A = 1 To objWordDok.Tables(1).Range.Cells.Count strText = objWordDok.Tables(1).Range.Cells(A) strText = Replace(Left$(strText, Len(strText) - 1), Chr(11), Chr(10)) Cells(objWordDok.Tables(1).Range.Cells(A).RowIndex, A) = strText Next A Set objWordApp = Nothing Set objWordDok = Nothing End Sub

Hallo,
ok Teste mal diesen Code.
Dieses Makro geht davon aus, dass sich diese Worddatei im gleichen Ordner wie die Excel befindet.
Liest die erste Tabelle im Worddokument.
Den Namen der Worddatei ("Dok1.doc") musst du noch anpassen.


Sub WordNachExcel()
Dim objWordApp As Word.Application
Dim objWordDok As Word.Document
Dim Pfad As String
Dim a As Long
Dim strText As Variant
On Error GoTo Fehler:
Application.ScreenUpdating = False
Pfad = _
IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
Set objWordApp = New Word.Application
objWordApp.Visible = False
Set objWordDok = objWordApp.Documents.Open(Pfad & "Dok1.doc")
With objWordDok.Tables(1).Range
For a = 1 To .Cells.Count
strText = .Cells(a)
strText = Replace(Replace(strText, Chr(7), ""), Chr(13), Chr(10))
If Right$(strText, 1) = Chr(10) Then strText = Left$(strText, Len(strText) - 1)
Cells(.Cells(a).RowIndex, .Cells(a).ColumnIndex) = strText
Next a
End With
Fehler:
On Error Resume Next
objWordDok.Close False
Set objWordApp = Nothing
Set objWordDok = Nothing
Application.ScreenUpdating = True
If Err.Number  0 Then MsgBox Err.Description, vbCritical, "Fehler beim lesen!"
End Sub

Gruß Tino

www.VBA-Excel.de

Beliebteste Forumthreads (12 Monate)

Probleme beim Kopieren Word Tabelle nach Excel

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

112 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Probleme beim Kopieren Word Tabelle nach Excel

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

112 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread