试试下面的代码,在网上找的
Sub 宏1()
Dim wordapp As Object
Dim mydoc
Dim mypath$, myname$
Dim wdRng As Object
Dim pos1%, pos2% '定义找到的字段的首位位置
Application.DisplayAlerts = False
Set wordapp = CreateObject("word.application")
mypath = ThisWorkbook.Path & ""
myname = Dir(mypath & "*.doc*")
Set mydoc = wordapp.Documents.Open(mypath & myname)
Set wdRng = mydoc.Range
wdRng.Find.Execute ("(一)")
pos1 = wdRng.Start
Set wdRng = mydoc.Range
wdRng.Find.Execute ("五、")
pos2 = wdRng.Start
mydoc.Range(pos1, pos2).Copy '选中找到的两个字段中间的内容
mydoc.Close False
wordapp.Quit
Worksheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub