|  
                                             
	Hi, 
	dein Code-Schnipsel funktioniert. 
	Ich würde dir mal meinen Code-Schnipsel zeigen. Bis jetzt komme ich soweit, das im Sheet (alles) mit Autofilter alles gesetzt wird. dies wird dann in den Sheet (word-kopierer) ab der Zelle 0,0 reinkopiert. Jetzt wird alles "sichtbare" (also alles was Text enthält) markiert und kopiert. Nun wird das Word Dokument geöffnet und es ab der Zeile 2 reinkopiert. 
Option Explicit 'neu
Const wdMove = 0        'Word-Konstanten
Const wdLine = 5
Const wdStory = 6
Const InsertLine = 2    'Word-Einfügzeile
Sub neuste_version()
    Dim DocPath As String
    DocPath = ThisWorkbook.Path & "\" & "test-doc.docx" 'Word-Dokument
    Dim AppWord As Object
    Set AppWord = CreateObject("Word.Application")
Dim strHaupt, Dpkt, Tabmin, Tabmax, strVer As String
strHaupt = "Alles"
' variablen Tabellengröße
Dpkt = ":"
Tabmin = [L3] & [J3]
Tabmax = [L3] & [J4]
strVer = Tabmin & Dpkt & Tabmax
MsgBox """Die Range beträgt""=" & strVer
' Arbeitsblätter Spalte A löschen
Sheets("word-kopierer").Select
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
' Auswahl-, Kopiervirgang und auto. Ausrichten
Sheets(strHaupt).Select
    Columns("A:H").Select
    Selection.autofilter
    ActiveSheet.Range("$A$1:$H$220").autofilter Field:=8, Criteria1:="Vertraulichkeit"
    ActiveSheet.Range("$A$1:$H$220").autofilter Field:=1, Criteria1:="Ja"
   
    With Sheets(strHaupt).Range(strVer)
        .Offset(1, 1).SpecialCells(xlCellTypeVisible).Copy
    End With
   
    Sheets("word-kopierer").Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).PasteSpecial xlPasteValues
    Sheets("word-kopierer").Select
    Columns("A:A").EntireColumn.AutoFit
    
   With Sheets("word-kopierer").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
    Sheets(strHaupt).UsedRange.autofilter
   
End Sub
	Wie bekomme ich deine ersten Code-Schnipsel bezüglich des Bookmarks hier rein. 
	Ich würde ja bei der Code-Zeile 
With .Selection
            .HomeKey Unit:=wdStory, Extend:=wdMove      'Position 1. Zeile setzen
            .MoveDown Unit:=wdLine, Count:=InsertLine   'Position n. Zeilen nach unten
            .Paste
End With
	statt der .HomeKey usw ja die Bookmark Optionen reinsetzen, aber bis jetzt haben meine Ideen nicht funktioniert wie ich das verwirklichen kann. 
	  
	Cheers 
     |