混合面饽饽
1.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。
2.VBA实现将EXCEL数据导入WORD表格
给你段示例，你再接着完善你的： Dim wdApp As Word.Application '定义WORD对象 Dim wdDoc As Word.Document '定义WORD文档对象 Dim wkSheet As Worksheet '定工作表对象 Dim I As Long '实例化WORD对象 Set wdApp = New Word.Application '创建WORD文档 Set wdDoc = wdApp.Documents.Add '给工作表变量赋值 Set wkSheet = ThisWorkbook.Sheets("WriteWord") '保存新创建的WORD文档 wdDoc.SaveAs ThisWorkbook.Path & "\test.docx" wdDoc.Close '关闭新创建的WORD文档 With wdApp '打开WORD文档 .Documents.Open ThisWorkbook.Path & "\test.docx" '循环将工作表中的记录转换为WORD文档内容 For I = 2 To wkSheet.Range("a1048576").End(xlUp).Row '题头内容 .Selection.TypeText "亲爱的" & Trim(wkSheet.Cells(I, 1).Value） '根据性别确定人物称呼 If wkSheet.Cells(I, 2).Value = "男" Then .Selection.TypeText "先生：" Else .Selection.TypeText "女士："。
. 。..。
3.求助EXCEL使用VBA批量打开一系列表格文件并复制里面的数据到另
Sub Copy_Data()Dim wb As Workbook, rng As Range, sht As WorksheetDim sht_Name, theDatesht_Name = "Sheet1" '假设所有报表文件中的数据都在 Sheet1Set sht = ActiveSheet '保存当前工作表对象fn = Dir(ThisWorkbook.Path & "\报表-*.xls", vbReadOnly) '打开第一个报表文件Do While fn <> "" '开始循环 Set wb = Workbooks.Open(fn) '以只读模式打开报表文件 '取得报表文件中的日期字符串 theDate = Mid(fn, InStr(fn， "\报表-") + 4, Len(fn) - InStr(fn， "\报表-") - 7） '将报表文件中的数据复制到当前工作表 With wb.Worksheets(sht_Name) .Range(.Range("A2"), .Range("A1").End(xlToRight).End(xlDown)).Copy _ Destination:=sht.Range("A65536").End(xlUp).Offset(1, 1) End With wb.Close (False) '关闭报表文件，不保存 sht.Activate '激活当前工作表 Range(Range("A65536").End(xlUp).Offset(1, 0), Range("B65536").End(xlUp).Offset(0, -1)) = DateValue(Format(theDate, "0000-00-00")） '在A列填充报表文件的日期信息 fn = DirLoop '循环下一个报表文件End Sub。
4.VBA实现将EXCEL数据导入WORD表格
给你段示例，你再接着完善你的：
Dim wdApp As Word.Application '定义WORD对象
Dim wdDoc As Word.Document '定义WORD文档对象
Dim wkSheet As Worksheet '定工作表对象
Dim I As Long
'实例化WORD对象
Set wdApp = New Word.Application
'创建WORD文档
Set wdDoc = wdApp.Documents.Add
'给工作表变量赋值
Set wkSheet = ThisWorkbook.Sheets("WriteWord")
'保存新创建的WORD文档
wdDoc.SaveAs ThisWorkbook.Path & "\test.docx"
wdDoc.Close '关闭新创建的WORD文档
With wdApp
'打开WORD文档
.Documents.Open ThisWorkbook.Path & "\test.docx"
'循环将工作表中的记录转换为WORD文档内容
For I = 2 To wkSheet.Range("a1048576").End(xlUp).Row
'题头内容
.Selection.TypeText "亲爱的" & Trim(wkSheet.Cells(I, 1).Value)
'根据性别确定人物称呼
If wkSheet.Cells(I, 2).Value = "男" Then
.Selection.TypeText "先生："
Else
.Selection.TypeText "女士："
. 。..
5.excel表格里的数字怎么复制到word中
是因为word表格里没有设置单元格格试为文本，当你在word里输入的是数字它就默认为数字型，输入文本就默认为字符型。
当从wor里复制时它就自动用“000……”代替15位以后的。 因为数字型的在电脑里只能在这个数字范围内。
要大量复制的话我有个办法可以让？？复制后不会出现这样的情况。 一、你在word里的15位以上的数字单元格前加“/”或“ '” 使word里的变成字符型。
二、选择要复制的表格，复制到excel。（这不用说了吧） 三、非常关键，在excel里。
刚刚复制好的15位以上的数字前面都会有你刚加入的“/”或“ ' ” 记得一定要先把单元格设置成文本--）再把“/”或“ ' ”删了。 注意：不能用替换来删。
但是可以查找。
6.excel中怎样用VBA实现自动复制一列数据到另一个工作表
代码如下。
详见附件 Private Sub Worksheet_Change(ByVal Target As Range) If Not Application.Intersect(Range("A1"), Target) Is Nothing And Target.Count = 1 Then Dim N& N = Val(Target) If N > 0 And N <= cells.columns.count="" then="" sheet1.columns(n).copy="" [a1]="" else="" columns(1).clearcontents="" end="" if="" end="" ifend="" sub="">
7.excel vba 代码求复制整行数据至其他表格中
以下代码你试试sheet1 是判断的工作表 改成你自己的sheet2 是粘贴的工作表 改成你自己的------代码开始-------Sub 判断复制（）Dim a%, b, cDob = b + 1 '行数累加If Sheets("Sheet1").Cells(b, 1) = "" Then Exit Do '判断单元格是否为空，为空时结束代码运行 也可以改成行数多少时结束如：if B>100 then exit suba = Cells(b, 1).Font.ColorIndex '获取字体颜色If a = 3 Then '判断字体颜色是否为红色（VBA中红色是3/excel中RGB(255,0,0)是红色）Sheets("Sheet1").Select '选中工作表Rows(b & ":" & b).Select '判断正确选择该行Selection.Copy '复制Sheets("sheet2").Select '选择sheet2工作表（sheet2可以更改为其它工作表）Range("A65536").SelectSelection.End(xlUp).Selectc = ActiveCell.Row + 1Range("A" & c).Select '选中最后使用单元格的下一个A列的值ActiveSheet.Paste '粘贴Sheets("Sheet1").Select '选中判断条件的单元格End IfLoopSheets("Sheet2").SelectApplication.CutCopyMode = FalseEnd Sub------代码结束-----------。
8.word vba如何批量复制表格并编号
下面这段代码是实现将excel表格插入到指定word模板的指定位置。
可以参考一下。Sub 插入表格（）Dim SS As StringDim wdoc As New Word.ApplicationDim 当前路径， 导出路径文件名， i, jDim Str1, Str2, Str3Dim tarr(1 To 100, 1 To 3)Dim filepathname As String当前路径 = ThisWorkbook.Path最后行号 = Sheets（"数字表格"）.Range("B30").End(xlUp).Row判断 = 0' 导出文件名 = "报告作品.doc"filepathname = 当前路径 & "\" & TfileIf Dir(filepathname) = "" Then'文件不存在FileCopy 当前路径 & "\" & Sfile， 当前路径 & "\" & TfileEnd IfSheets（"数字表格"）.SelectFor i = KShh To 最后行号tarr(i - KShh + 1, 1) = Sheets（"数字表格"）.Cells(i, 1)tarr(i - KShh + 1, 2) = Sheets（"数字表格"）.Cells(i, 2)tarr(i - KShh + 1, 3) = Sheets（"数字表格"）.Cells(i, 3)Next ij = i - KShh '记录需替换文本个数导出路径文件名 = 当前路径 & "\" & TfileWith wdoc '打开word文档.Documents.Open 导出路径文件名.Visible = TrueEnd WithFor i = 1 To jStr1 = tarr(i, 1)Str2 = tarr(i, 2)Str3 = tarr(i, 3)Range(Str3).SelectApplication.CutCopyMode = FalseSelection.CopyWith wdoc.Selection.HomeKey Unit:=wdStory '光标置于文件首If .Selection.Find.Execute(Str1) Then '查找到指定字符串.Selection.Text = "" '替换字符串.Selection.PasteExcelTable False, False, False '粘贴为表格.Selection.WholeStory.Selection.Font.Size = 12With .Options.DefaultBorderLineStyle = wdLineStyleSingle.DefaultBorderLineWidth = wdLineWidth050pt.DefaultBorderColor = wdColorAutomaticEnd With.Selection.Tables(1).PreferredWidthType = 3.Selection.Tables(1).PreferredWidth = .CentimetersToPoints(15)End If' wdoc.Documents.Save' wdoc.Quit' Set wdoc = NothingEnd WithNext iWith wdoc '存盘后关闭WORD文档wdoc.Documents.Savewdoc.QuitSet wdoc = NothingEnd WithSheets（"首页"）.SelectEnd Sub。
转载请注明出处51数据库 » excelvba复制到word表格数
