Sub CombineAll(sPath As String)
    Dim baseDoc As Document, sFile As String
    Dim oRng As Range
    ' Read the Size of the Splitter from the Bookmark in the control document
    Dim Splitter As Integer
    If ActiveDocument.Bookmarks.Exists("Splitter") Then
        On Error GoTo NoSplitter
        Splitter = Int(ActiveDocument.Bookmarks("Splitter").Range.Text)
    End If
    
    On Error GoTo err_Handler
    Set baseDoc = Application.Documents.Add
    sFile = Dir(sPath & "*.doc")
    ' Loop through the .doc in the output directory
    Dim DocSet As Integer: DocSet = 1
    Do While sFile <> ""
        ' Go to the end of the master document
        Set oRng = baseDoc.Range
        oRng.Collapse wdCollapseEnd
        ' add document set
        oRng.InsertFile sPath & sFile
        Set oRng = baseDoc.Range
        oRng.Collapse wdCollapseEnd
        ' insert section break at end of master document
        oRng.InsertBreak Type:=wdSectionBreakNextPage
        ' next file
        sFile = Dir
        DoEvents
        ' splitm up and re-number pages
        If DocSet > 1 And DocSet Mod Splitter = 0 Then
            RebuildNumbering
            ActiveDocument.SaveAs (sPath & DocSet & "_Teildokument.doc")
            ' open a new document when splitted 
            Set baseDoc = Application.Documents.Add
        End If
        DocSet = DocSet + 1
    Loop
    
lbl_Exit:
    ' Re-number the last document
    RebuildNumbering
    Debug.Print "Stitching Process complete"
    Set baseDoc = Nothing
    Set oRng = Nothing
    MsgBox "Fertig"
    Exit Sub
NoSplitter:
    MsgBox "Aufsplittungswert in Steuerdokument nicht gesetzt (1 < Wert < 51 && Lesezeichen auf Wert)"
    Set baseDoc = Nothing
    Set oRang = Nothing
    End
err_Handler:
    MsgBox Err.Number & vbCr & Err.Description
    Err.Clear
End Sub

Sub RebuildNumbering()
    ' re-number pages
    Dim sc As Integer: sc = ActiveDocument.Sections.Count
    For S = 1 To sc
        ' process= unlink from previous section, reset page numbers neustarten am Sektionsbeginn
        ActiveDocument.Sections(S).Footers(wdHeaderFooterFirstPage).LinkToPrevious = False
        With ActiveDocument.Sections(S).Footers(wdHeaderFooterFirstPage)
            .PageNumbers.RestartNumberingAtSection = True
            .PageNumbers.NumberStyle = wdPageNumberStyleArabic
            .PageNumbers.StartingNumber = 1
        End With
    Next S
    Debug.Print "Renumbering Done"
End Sub