vba怎么复制另一个word

1.求VBA高手指点!!如何把一个word文档的内容插入到另一个word中

sub aa()

dim projectno as string, projectname as string, datereceive as date, datecomplate as date, functionary as string

dim arr as object

dim i as long

dim brr

projectno = activedocument.sections(1).headers(wdheaderfooterprimary).range.tables(1).cell(1, 2).range

dim excelobject as object

set excelobject = getobject("d:\downloads\project(word)\project.xls")

set arr = excelobject.sheets(1).usedrange()

brr = arr

for i = 2 to ubound(brr)

if instr(1, projectno, brr(i, 1)) >0 then

projectname = brr(i, 2)

datereceive = brr(i, 3)

datecomplate = brr(i, 4)

functionary = brr(i, 5)

exit for

end if

next i

activedocument.tables(1).cell(1, 2).range = projectname

activedocument.tables(1).cell(2, 2).range = datereceive

activedocument.tables(1).cell(3, 2).range = datecomplate

activedocument.tables(1).cell(4, 2).range = functionary

excelobject.close false

end sub

2.请教:如何用VBA把数据从一个表复制到另一个表中?请问:想用VB

其实你提出的这个问题，用函数就可以解决。

涉及跨表存取数据，打开表执行查找后再关闭，程序的运行效率不高。 下面的代码实际就是用函数执行查找，然后处理成数值，感觉可能要快一点。

引用各科成绩的数据原理和引用考场号是一样的，只要修改代码中公式的内容就好了， Sub 从登分表中导入考场座号数据（） Application。 ScreenUpdating = False Dim wstTemp As Worksheet, intRow% For Each wstTemp In ActiveWorkbook。

Worksheets With wstTemp intRow = 。 [A65536]。

End(xlUp)。Row If wstTemp。

Name Like "*文*" Then 。Range("G3:G" & intRow)。

FormulaR1C1 = "=VLOOKUP(RC[-6]，[文登分表。 xls]文科登分表！C1:C5,4,0)" 。

Range("H3:H" & intRow)。FormulaR1C1 = "=VLOOKUP(RC[-7]，[文登分表。

xls]文科登分表！C1:C5,5,0)" 。Range("G3:H" & intRow)。

Copy 。Range("G3:H" & intRow)。

PasteSpecial xlPasteValues, xlNone, False, False ElseIf wstTemp。Name Like "*理*" Then 。

Range("G3:G" & intRow)。FormulaR1C1 = "=VLOOKUP(RC[-6]，[理登分表。

xls]理科登分表！C1:C5,4,0)" 。Range("H3:H" & intRow)。

FormulaR1C1 = "=VLOOKUP(RC[-7]，[理登分表。 xls]理科登分表！C1:C5,5,0)" 。

Range("G3:H" & intRow)。Copy 。

Range("G3:H" & intRow)。PasteSpecial xlPasteValues, xlNone, False, False End If End With Next Application。

ScreenUpdating = True End Sub Sub 清除考场座号数据（） Application。ScreenUpdating = False Dim wstTemp As Worksheet, intRow% For Each wstTemp In ActiveWorkbook。

Worksheets With wstTemp If wstTemp。Name Like "*文*" Or wstTemp。

Name Like "*理*" Then intRow = 。[A65536]。

End(xlUp)。 Row 。

Range("G3:H" & intRow)。ClearContents End If End With Next Application。

ScreenUpdating = True End Sub。

3.VBA 用excel模块复制word的表格内容

试试下面的代码：

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 = TrueEnd Sub