Hallo,

ich habe eine Excel-Datei.

In dem erstem Sheet (Name:Alles) gibt es mehrere Zeilen, welche durch ein Makro in den entsprechenden anderen Sheets (Namen:1-10) verteilt werden.

Ich habe im Netz mehrere Codes gefunden welche die ausgewählten Daten in ein Word-Dokument kopieren.

Meine Probleme:

1) Es sollen nur Zeilen mit Inhalt nach Word kopiert werden. Die Anzahl an Zeilen variiert.

2) Die Daten sollen in Word an einen Bookmark-Stelle kopiert werden. Nicht hintereinander weg, sondern untereinander.

3) Jedes Sheet soll in eine separate Bookmark.

Ich habe es hin bekommen, das die Daten untereinander in Word kopiert werden, aber nicht an die Bookmark stelle.

Oder es werden die Daten an die Bookmark-Stelle kopiert, aber nach einander ohne neue Zeile in Word.

Auch kann in  in dem einem Skript nur eine Zeile (Range("A3") angeben. Hier suche ich nach einer Lösung, das die Rangeliste variabel ist.

Jetzt kommen die drei Skripte mit denen es mir zum Teil gelungen ist dies um zusetzen, aber noch nicht die gewollte Lösung enthält.

1tes Makro:

Option Explicit

Public Sub Test()

    Dim strFileName As String

    Dim strTMP1 As String

    Dim strTMP2 As String

    Dim strTMP3 As String

    Dim objWDApp As Object

    Dim objDoc As Object

    On Error GoTo Fin

    strFileName = ThisWorkbook.Path & "\" & "test-doc.docx" 'adapt

    If Dir(strFileName) <> "" Then

        Application.ScreenUpdating = False

        With Sheets("1")

            strTMP1 = .Range("A3")

         '   strTMP2 = .Range("C17")

         '   strTMP3 = .Range("D12")

        End With

        On Error Resume Next

        Set objWDApp = GetObject(, "Word.Application")

        If objWDApp Is Nothing Then Set objWDApp = CreateObject("Word.Application")

        On Error GoTo 0

        With objWDApp

            .Visible = False 'Or True, if Word is to be indicated

            Set objDoc = .Documents.Open(strFileName)

            .ActiveDocument.Bookmarks("Bookmark1").Range = strTMP1

            '.ActiveDocument.Bookmarks("Bookmark2").Range = strTMP2

            '.ActiveDocument.Bookmarks("Bookmark3").Range = strTMP3

        End With

        MsgBox "Finished!"

    Else

        MsgBox "No file!"

    End If

Fin:

    Application.ScreenUpdating = True

    If Not objDoc Is Nothing Then objDoc.Save

    If Not objWDApp Is Nothing Then objWDApp.ActiveDocument.Close: objWDApp.Quit

    Set objWDApp = Nothing

End Sub

2tes Makro:

Public Sub CommandButton5_Click()

Dim AppWord As Word.Application

Set AppWord = CreateObject("Word.Application")

AppWord.Visible = True

With Sheets("1").Range("A:A")

.Offset(0, 0).SpecialCells(xlCellTypeVisible).Copy

End With

'Sheets("1").Range(Cells(1, 1), Cells(7, 1)).Copy

AppWord.Documents.Add

AppWord.Selection.Paste

Application.CutCopyMode = False

Set AppWord = Nothing

End Sub

3tes Makro:

Hier wäre es super, wenn ich irgend die die Bookmarks reinbekommen würde.

Const wdMove = 0        'Word-Konstanten

Const wdLine = 5

Const wdStory = 6

Const InsertLine = 4    'Word-Einfügzeile

Sub nachword()

    Dim DocPath As String

    DocPath = ThisWorkbook.Path & "\" & "test-doc.docx" 'Word-Dokument

    Dim AppWord As Object

    Set AppWord = CreateObject("Word.Application")

    With Sheets("1").Range("A:A")

    .Offset(0, 0).SpecialCells(xlCellTypeVisible).Copy

    End With

    With AppWord

        .Visible = True

        .Documents.Open DocPath

         With .Selection

            .HomeKey Unit:=wdStory, Extend:=wdMove      'Position 1. Zeile setzen

            .MoveDown Unit:=wdLine, Count:=InsertLine   'Position n. Zeilen nach unten

            .Paste

         End With

    End With

    Set AppWord = Nothing

    Application.CutCopyMode = False

End Sub