Private strWorkbook As String
Private strSheet As String
Sub FindWordCopySentence()

    Dim appExcel As Object
    Dim strSheet As Object
    Dim aRange As Range
    Dim intRowCount As Integer
    intRowCount = 1
    Set aRange = ActiveDocument.Range
    With aRange.Find
        Do
            .Text = "shall" ' the word I am looking for
            .Execute
            If .found Then
                aRange.Expand Unit:=wdSentence
                aRange.Copy
                aRange.Collapse wdCollapseEnd
                If objSheet Is Nothing Then
                    Set appExcel = CreateObject("Excel.Application")
                     'Change the file path to match the location of your test.xls
                     
                    Set strSheet = BrowseForFile("Select Workbook", True)
                    If Not strSheet = vbNullString Then
                    
                    strSheet = InputBox("Please enter the name of the Sheet", "Worksheet", "Please enter the name of the Sheet")
                    If Not strSheet = vbNullString Then
                    
                    intRowCount = 1
                End If
                objSheet.Cells(intRowCount, 1).Select
                objSheet.Paste
                intRowCount = intRowCount + 1
            End If
        Loop While .found
    End With
    If Not objSheet Is Nothing Then
        appExcel.Workbooks(1).Close True
        appExcel.Quit
        Set objSheet = Nothing
        Set appExcel = Nothing
    End If
    Set aRange = Nothing
End Sub
Private Function BrowseForFile(Optional strTitle As String, Optional bExcel As Boolean) As String
Dim fDialog As FileDialog
    On Error GoTo err_Handler
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .Title = strTitle
        .AllowMultiSelect = False
        .Filters.Clear
        If bExcel Then
            .Filters.add "Excel workbooks", "*.xls,*.xlsx,*.xlsm"
        Else
            .Filters.add "Word documents", "*.doc,*.docx,*.docm"
        End If
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then GoTo err_Handler:
        BrowseForFile = fDialog.SelectedItems.Item(1)
    End With
lbl_Exit:
    Exit Function
err_Handler:
    BrowseForFile = vbNullString
    Resume lbl_Exit
End Function