The following will add the found items to an array and you can write that array to a worksheet as shown
Sub Macro1()
Dim arrList() As String
Dim oRng As Range
Dim xlApp As Object
Dim xlBook As Object
Dim NextRow As Integer, i As Integer
Const strFind As String = "Modelo:^t"
    Set oRng = ActiveDocument.Range
    ReDim arrList(0)
    With oRng.Find
        Do While .Execute(FindText:=strFind)
            oRng.Collapse 0
            oRng.End = oRng.Paragraphs(1).Range.End - 1
            If Not Left(oRng.Text, 9) = "IFC 100 W" Or _
               Not Left(oRng.Text, 9) = "IFC 100 C" Or _
               Not Left(oRng.Text, 9) = "IFC 070 C" Or _
               Not Left(oRng.Text, 9) = "IFC 070 F" Or _
               Not Left(oRng.Text, 9) = "IFC 050 C" Or _
               Not Left(oRng.Text, 9) = "IFC 050 W" Or _
               Not Left(oRng.Text, 13) = "Optiflux 2000" Or _
               Not Left(oRng.Text, 5) = "V/Ref" Or _
               Not Left(oRng.Text, 13) = "Optiflux 1000" Then
                ReDim Preserve arrList(UBound(arrList) + 1)
                arrList(UBound(arrList)) = oRng.Text
            End If
            oRng.Collapse 0
        Loop
    End With
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlBook = xlApp.Workbooks.Add
    xlBook.Sheets(1).Cells(1, 1).value = "Modelo"
    xlApp.Visible = True
    For i = 0 To UBound(arrList)
        NextRow = xlBook.Sheets(1).Range("A" & xlBook.Sheets(1).Rows.Count).End(-4162).Row + 1
        xlBook.Sheets(1).Cells(NextRow, 1).value = arrList(i)
    Next i
lbl_Exit:
    Set oRng = Nothing
    Set xlApp = Nothing
    Set xlBook = Nothing
    Exit Sub
End Sub