Sub KopierenTextmarken()
Dim oDoc As Document
Dim nDoc As Document
Set oDoc = ActiveDocument
Set nDoc = Documents.Open("H:\Tausch\mitteilung an SWK.docx")
fkt_ReplaceBookmarkText oDoc, nDoc, "a", "a"
fkt_ReplaceBookmarkText oDoc, nDoc, "b", "b"
fkt_ReplaceBookmarkText oDoc, nDoc, "ausfertigung", "c"
End Sub
Function fkt_ReplaceBookmarkText(ByRef oSource As Document, oTarget As Document, oSource_TM As String, oTarget_TM As String)
Dim rng As Range
If oSource.Bookmarks.Exists(oSource_TM) And oTarget.Bookmarks.Exists(oTarget_TM) Then
Set rng = oTarget.Bookmarks(oTarget_TM).Range
rng.Text = oSource.Bookmarks(oSource_TM).Range.Text
oTarget.Bookmarks.Add oTarget_TM, rng
End If
End Function