Hallo, 

vielen Dank für Ihre Hilfe. Genau diese Programmzeilen haben mir noch gefehlt. Der Code sieht jetzt wie folgt aus:

Sub DokumentEinlesenUndInNeuemDokumentAusgeben()
'
' DokumentEinlesenUndInNeuemDokumentAusgeben Makro
'
'
    'Zeile als String
    Dim strLine As String
    'colString als Sammlung
    Dim colString As Collection
    'Letzte Zeile
    Dim intLastLine As Integer
    'Letzte Seite
    Dim intLastPage As Integer
    'Markierung (Boolean ja/nein)
    Dim flag As Boolean
    'Variable für Itemnummer
    Dim i As Long
    
    Dim Ansicht As Long

    'letzte Zeilennummer
    Selection.EndKey unit:=wdStory
    intLastLine = _
    Selection.Range.Information(wdFirstCharacterLineNumber)
    intLastPage = _
    Selection.Range.Information(wdActiveEndPageNumber)
    'mit String-Sammlung beginnen
    Set colString = New Collection
    'zurück zum Anfang
    Selection.HomeKey unit:=wdStory

    'Schleife bis zum Ende des Dokuments
    flag = True
    While flag = True
        'Prüfe, ob das Ende des Dokuments erreicht ist
        If (Selection.Range.Information(wdFirstCharacterLineNumber) = intLastLine) And intLastPage = _
        Selection.Range.Information(wdActiveEndPageNumber) Then
            flag = False
        End If
    'Zeile auswählen
    Selection.EndKey unit:=wdLine, Extend:=wdExtend
    'Zeileninhalt
    strLine = Selection.Range.Text
    colString.Add (strLine)
    'eine Zeile nach unten rutschen
    Selection.MoveDown unit:=wdLine, Count:=1
    Selection.HomeKey unit:=wdLine
    Wend
    
'*******Ausgeben*******

    'aktuelles Dokument
    Dim aDok As Document
    'neues Dokument
    Dim nDok As Document
    
    'Verweis auf Dokument setzen
    Set aDok = ActiveDocument
    'Neues Dokument öffnen mit gleichem Layout
    Set nDok = Documents.Add _
    (Template:=aDok.AttachedTemplate.FullName)
    
    'Cursor auf 1. Position setzen
    nDok.Range(0, 0).Select
    
    For i = 1 To colString.Count - 1
        Selection.TypeText Text:=colString.Item(i)
        Selection.MoveDown unit:=wdLine, Count:=1
    Next i
  
End Sub

Es funktioniert alles so weit, allerdings würde es mich freuen, wenn die Wörter auch richtig formatiert werden würden (Unterstrichen/Fett/etc.). Kann mir da vielleicht jemand weiter helfen?

Gruß Ben