Sub ScratchMacro()
 'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 01/31/2019
Dim oRng As Range
Dim arrFind() As String
Dim lngIndex As Long
Dim strContent
Dim oThisDoc As Document
Dim oDoc As Document
  
  Set oThisDoc = ActiveDocument
  arrFind = Split("1945,1946,1947", ",")
  For lngIndex = 0 To UBound(arrFind)
    oThisDoc.Activate
    strContent = vbNullString
    Set oRng = ActiveDocument.Range
    With oRng.Find
      .ClearFormatting
      .Text = arrFind(lngIndex)
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      Do While .Execute
        strContent = strContent & oRng.Paragraphs(1).Range.Text & vbCr
      Loop
      If strContent <> vbNullString Then
        Set oDoc = Documents.Add(, , wdNewBlankDocument)
        oDoc.Range.Text = strContent
      End If
    End With
  Next lngIndex
lbl_Exit:
  Exit Sub
End Sub