Based on your comments, the following should work

Sub BreakIt()
'Graham Mayor - https://www.gmayor.com - Last updated - 01 Jan 2021 
Dim MainDoc As Document, SubDoc As Document, SectionNo%, sPath$
Dim oSection As Section
    Set MainDoc = ActiveDocument
    'remove the empty sections
    For Each oSection In MainDoc.Sections
        If Len(oSection.Range) < 3 Then oSection.Range.Delete
    Next oSection
    '==========
    sPath = MainDoc.path
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"


    For SectionNo = 1 To MainDoc.Sections.Count
        MainDoc.Sections(SectionNo).Range.Copy
        'base the new documents on the original document thus preserving the header/footer
        Set SubDoc = Application.Documents.Add(MainDoc.FullName)
        SubDoc.Range.Paste
        SubDoc.SaveAs sPath & Left(MainDoc.Name, Len(MainDoc.Name) - 4) & _
                      SectionNo & ".doc"  'doc format?
        SubDoc.Close
    Next SectionNo
    Set SubDoc = Nothing
    Set MainDoc = Nothing
    Set oSection = Nothing
End Sub
If all the documents are similarly formatted e.g. as a result of a mail merge, then see  https://www.gmayor.com/MergeAndSplit.htm