Option Explicit
Const wdMove = 0
Const wdLine = 5
Const wdStory = 6
Const InsertLine = 2
Sub neuste_version()
Dim DocPath As String
DocPath = ThisWorkbook.Path & "\" & "test-doc.docx"
Dim AppWord As Object
Set AppWord = CreateObject("Word.Application")
Dim strHaupt, Dpkt, Tabmin, Tabmax, strVer As String
strHaupt = "Alles"
Dpkt = ":"
Tabmin = [L3] & [J3]
Tabmax = [L3] & [J4]
strVer = Tabmin & Dpkt & Tabmax
MsgBox """Die Range beträgt""=" & strVer
Sheets("word-kopierer").Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
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
.MoveDown Unit:=wdLine, Count:=InsertLine
.Paste
End With
End With
Set AppWord = Nothing
Application.CutCopyMode = False
Sheets(strHaupt).UsedRange.autofilter
End Sub