メモ帳

Sub CopyFromKeyword()

    Dim keyword As String

    Dim doc As Document

    Dim findRng As Range

    Dim copyRng As Range

    keyword = "ここにキーワードを入力" ' ← 一度だけ変更してください

    Set doc = ActiveDocument

    Set findRng = doc.Content

    With findRng.Find

        .Text = keyword

        .Execute

    End With

    If findRng.Find.Found Then

        Set copyRng = doc.Range(findRng.Start, doc.Content.End)

        copyRng.Copy

        MsgBox "コピーしました"

    Else

        MsgBox "「" & keyword & "」が見つかりませんでした"

    End If

End Sub