I have added the filename in the code below. What is the purpose of the section break you want adding? It is not required for the process you outlined and there is already a page break between the Word documents. The code works provided the documents are similar to the sample you posted.
Code:
Option Explicit
Sub ExtractData()
'Graham Mayor - https://www.gmayor.com - Last updated - 23 Nov 2021
Dim oDoc As Document
Dim oSource As Document
Dim oRng As Range, oDocRng As Range
Dim lSec As Long, lPara As Long
Dim fDialog As FileDialog
Dim strPath As String, strFile As String
If Documents.Count = 0 Then Documents.Add
Set oDoc = ActiveDocument
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
End With
strFile = Dir$(strPath & "*.docx")
While strFile <> ""
Set oSource = Documents.Open(strPath & strFile)
Set oRng = oSource.Range
With oRng.Find
Do While .Execute("^m")
oRng.Text = ""
oRng.InsertBreak wdSectionBreakNextPage
oRng.Collapse 0
Loop
End With
If Len(oDoc.Range) > 1 Then
Set oRng = oDoc.Range
oRng.Collapse 0
oRng.InsertBreak wdPageBreak
End If
For lSec = 1 To oSource.Sections.Count
For lPara = 1 To oSource.Sections(lSec).Range.Paragraphs.Count
If oSource.Sections(lSec).Range.Paragraphs(lPara).Range.Text Like "*System Safety Assessment Summary*" Then
If oSource.Sections(lSec).Range.Paragraphs(lPara).Range.Style = "ForCertPlanTOC" Then
Set oDocRng = oDoc.Range
oDocRng.Collapse 0
oDocRng.Text = oSource.Name & vbCr
oDocRng.Collapse 0
oDocRng.FormattedText = oSource.Sections(lSec).Range.FormattedText
oDocRng.InsertParagraphAfter
Exit For
End If
End If
Next lPara
For lPara = 1 To oSource.Sections(lSec).Range.Paragraphs.Count
If oSource.Sections(lSec).Range.Paragraphs(lPara).Range.Text Like "*Hardware Considerations*" Then
If oSource.Sections(lSec).Range.Paragraphs(lPara).Range.Style = "ForCertPlanTOC" Then
Set oDocRng = oDoc.Range
oDocRng.Collapse 0
oDocRng.FormattedText = oSource.Sections(lSec).Range.FormattedText
oDocRng.InsertParagraphAfter
Exit For
End If
End If
Next lPara
Next lSec
If oDoc.Sections.Count > 2 Then
Set oRng = oDoc.Sections.Last.Range.Previous
oRng.End = oDoc.Range.End
oRng.Delete
End If
oSource.Close SaveChanges:=wdDoNotSaveChanges
strFile = Dir$()
Wend
lbl_Exit:
Set fDialog = Nothing
Set oSource = Nothing
Set oDoc = Nothing
Set oRng = Nothing
Set oDocRng = Nothing
Exit Sub
End Sub