Excel VBA分页符

我有一个工作簿，里面有很多工作表，我正试图将其中的内容复制并粘贴到word文档中。现在，代码在所有工作表中循环，并将它们粘贴到word文档中，但它们彼此重叠。我必须更改

wdDoc.Range（wdDoc.Characters.Count-1）。将
wdDoc.Range（wdDoc.Characters.Count-1）粘贴到
wdDoc.Range（wdDoc.Characters.Count-1）。粘贴exceltable False、False、False
，我不确定这是否是问题的根源；看起来好像正在创建一个新页面，但下一个工作表的内容没有粘贴到其中。我没有收到任何错误消息。任何建议都将不胜感激

Sub toWord()
Dim ws As Worksheet
Dim fromWB As Variant
Dim wdApp As Object
Dim wdDoc As Object
Dim docName As Variant
Dim rng As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False


Set wdApp = CreateObject("Word.Application")
 wdApp.Visible = True
Set wdDoc = wdApp.Documents.Add
wdDoc.Activate
'Creates InputBox that allows user to enter name to save document as
docName = Application.InputBox(Prompt:="Enter Document Name", Title:="Save Word Document", Type:=2)
wdDoc.SaveAs2 fileName:=docName, FileFormat:=wdFormatDocument 'Saves document under user-provided name

fromWB = Application.GetOpenFilename(FileFilter:="Excel Workbook(*.xlsx),*.xlsx", Title:="Open Merged Data")
If fromWB <> False Then
Set fromWB = Workbooks.Open(fromWB)
ElseIf fromWB = False Then
    MsgBox "No File Selected"
    GoTo ResetSettings
End If


For Each ws In fromWB.Worksheets
    ws.Activate
    ws.Range("A1:A2").Select
    Selection.Copy
    Set wdApp = GetObject(, "Word.Application")
    wdApp.Visible = True
    wdDoc.Activate
    wdDoc.Range.Paste

    ws.Activate

    If ws.Range("A3").Value <> "" Then
    Range("A2").CurrentRegion.Offset(2).Resize(Range("A2").CurrentRegion.Rows.Count - 2).Select
    Selection.Columns.AutoFit
    Selection.Copy
    Set wdApp = GetObject(, "Word.Application")
    wdApp.Visible = True
    wdDoc.Activate
    wdApp.Selection.EndKey Unit:=wdStory
    wdApp.Selection.MoveDown Unit:=wdLine, Count:=1
    wdApp.Selection.TypeParagraph
    wdDoc.Range(wdDoc.Characters.Count - 1).PasteExcelTable False, False, False
    wdApp.Selection.Tables(1).Rows.Alignment = wdAlignRowCenter


    wdDoc.Range.Collapse Direction:=0
    wdDoc.Range(wdDoc.Characters.Count - 1).InsertBreak Type:=7
   End If
Next ws

wdDoc.Styles("Normal").NoSpaceBetweenParagraphsOfSameStyle = True
wdDoc.Save
Set wdDoc = Nothing
Set wdApp = Nothing
Set fromWB = Nothing
MsgBox "Imported into Word Document"


ResetSettings:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

Sub-toWord（）
将ws设置为工作表
Dim fromWB作为变体
作为对象的应用程序
Dim wdDoc作为对象
Dim docName作为变量
变暗rng As范围
Application.ScreenUpdating=False
Application.DisplayAlerts=False
Application.EnableEvents=False
Set wdApp=CreateObject（“Word.Application”）
wdApp.Visible=True
设置wdDoc=wdApp.Documents.Add
wdDoc.Activate
'创建允许用户输入文档另存为的名称的InputBox
docName=应用程序.InputBox（提示：=“输入文档名称”，标题：=“保存Word文档”，类型：=2）
wdDoc.SaveAs2 fileName:=docName，FileFormat:=wdFormatDocument'以用户提供的名称保存文档
fromWB=Application.GetOpenFilename（文件过滤器：=“Excel工作簿（*.xlsx），*.xlsx”，标题：=“打开合并数据”）
如果fromWB为False，则
Set fromWB=工作簿。打开（fromWB）
ElseIf fromWB=则为False
MsgBox“未选择任何文件”
转到重置设置
如果结束
对于fromWB.工作表中的每个ws
ws.Activate
ws.范围（“A1:A2”）。选择
选择，复制
Set wdApp=GetObject（，“Word.Application”）
wdApp.Visible=True
wdDoc.Activate
wdDoc.Range.Paste
ws.Activate
如果ws.Range（“A3”）.值为“”，则
范围（“A2”）.CurrentRegion.Offset（2）.调整大小（范围（“A2”）.CurrentRegion.Rows.Count-2）.选择
Selection.Columns.AutoFit
选择，复制
Set wdApp=GetObject（，“Word.Application”）
wdApp.Visible=True
wdDoc.Activate
wdApp.Selection.EndKey单位：=wdStory
wdApp.Selection.MoveDown单位：=wdLine，计数：=1
wdApp.Selection.TYPE段落
wdDoc.Range（wdDoc.Characters.Count-1）.可粘贴的False、False、False
wdApp.Selection.Tables（1）.Rows.Alignment=wdAlignRowCenter
wdDoc.Range.Collapse方向：=0
wdDoc.Range（wdDoc.Characters.Count-1）。插入中断类型：=7
如果结束
下一个ws
wdDoc.Styles（“正常”）.NoSpaceBetweenParagraphsOfSameStyle=True
wdDoc.Save
设置wdDoc=Nothing
设置wdApp=Nothing
Set fromWB=无
MsgBox“导入Word文档”
重置设置：
Application.ScreenUpdating=True
Application.DisplayAlerts=True
Application.EnableEvents=True
端接头
测试时编辑占位符：

Sub asdf()
    Dim ws As Worksheet
    Const wdStory = 6
    Const wdMove = 0

    For Each ws In ThisWorkbook.Worksheets
        ws.Range("A7").Copy
        Set docApp = GetObject(, "Word.Application")
        Set doc = docApp.Documents.Open("PATH OF FILE")
        docApp.Selection.EndKey wdStory
        docApp.Selection.PasteAndFormat wdPasteDefault
    Next ws

End Sub

测试时编辑占位符：

Sub asdf()
    Dim ws As Worksheet
    Const wdStory = 6
    Const wdMove = 0

    For Each ws In ThisWorkbook.Worksheets
        ws.Range("A7").Copy
        Set docApp = GetObject(, "Word.Application")
        Set doc = docApp.Documents.Open("PATH OF FILE")
        docApp.Selection.EndKey wdStory
        docApp.Selection.PasteAndFormat wdPasteDefault
    Next ws

End Sub

以下是我要使用的代码：

Sub toWord()
Dim ws As Worksheet
Dim fromWB As Variant
Dim wdApp As Object
Dim wdDoc As Object
Dim docName As Variant
Dim rng As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False


Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Add
wdDoc.Activate
'Creates InputBox that allows user to enter name to save document as
docName = Application.InputBox(Prompt:="Enter Document Name", Title:="Save Word Document", Type:=2)
wdDoc.SaveAs2 fileName:=docName, FileFormat:=wdFormatDocument 'Saves document under user-provided name

fromWB = Application.GetOpenFilename(FileFilter:="Excel Workbook(*.xlsx),*.xlsx", Title:="Open Merged Data")
If fromWB <> False Then
Set fromWB = Workbooks.Open(fromWB)
ElseIf fromWB = False Then
    MsgBox "No File Selected"
    GoTo ResetSettings
End If

For Each ws In fromWB.Worksheets
    ws.Activate
    ws.Range("A1:A2").Select
    Selection.Copy
    Set wdApp = GetObject(, "Word.Application")
    wdApp.Visible = True
    wdDoc.Activate
    wdDoc.Range(wdDoc.Characters.Count - 1).Paste

    ws.Activate
    If ws.Range("A4").Value <> "" Then
    Application.Intersect(ws.UsedRange, ws.Cells.Resize(ws.Rows.Count - 2).Offset(2)).Select
    Selection.Columns.AutoFit
    Selection.Copy
    Set wdApp = GetObject(, "Word.Application")
    wdApp.Visible = True
    wdDoc.Activate
    wdApp.Selection.EndKey Unit:=wdStory
    wdApp.Selection.MoveDown Unit:=wdLine, Count:=1
    wdApp.Selection.TypeParagraph
    wdDoc.Range(wdDoc.Characters.Count - 1).PasteExcelTable False, False, False
    wdApp.Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
    wdApp.Selection.Collapse Direction:=0
    wdDoc.Range(wdDoc.Characters.Count - 1).InsertBreak Type:=7
   Else
   wdDoc.Range(wdDoc.Characters.Count - 1).InsertBreak Type:=7
   End If
Next ws

wdDoc.Styles("No Spacing").NoSpaceBetweenParagraphsOfSameStyle = True
wdDoc.Save
Set wdDoc = Nothing
Set wdApp = Nothing
Set fromWB = Nothing
MsgBox "Imported into Word Document"


ResetSettings:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

Sub-toWord（）
将ws设置为工作表
Dim fromWB作为变体
作为对象的应用程序
Dim wdDoc作为对象
Dim docName作为变量
变暗rng As范围
Application.ScreenUpdating=False
Application.DisplayAlerts=False
Application.EnableEvents=False
Set wdApp=CreateObject（“Word.Application”）
wdApp.Visible=True
设置wdDoc=wdApp.Documents.Add
wdDoc.Activate
'创建允许用户输入文档另存为的名称的InputBox
docName=应用程序.InputBox（提示：=“输入文档名称”，标题：=“保存Word文档”，类型：=2）
wdDoc.SaveAs2 fileName:=docName，FileFormat:=wdFormatDocument'以用户提供的名称保存文档
fromWB=Application.GetOpenFilename（文件过滤器：=“Excel工作簿（*.xlsx），*.xlsx”，标题：=“打开合并数据”）
如果fromWB为False，则
Set fromWB=工作簿。打开（fromWB）
ElseIf fromWB=则为False
MsgBox“未选择任何文件”
转到重置设置
如果结束
对于fromWB.工作表中的每个ws
ws.Activate
ws.范围（“A1:A2”）。选择
选择，复制
Set wdApp=GetObject（，“Word.Application”）
wdApp.Visible=True
wdDoc.Activate
wdDoc.Range（wdDoc.Characters.Count-1）.粘贴
ws.Activate
如果ws.Range（“A4”）.值为“”，则
Intersect（ws.UsedRange，ws.Cells.Resize（ws.Rows.Count-2）.Offset（2））。选择
Selection.Columns.AutoFit
选择，复制
Set wdApp=GetObject（，“Word.Application”）
wdApp.Visible=True
wdDoc.Activate
wdApp.Selection.EndKey单位：=wdStory
wdApp.Selection.MoveDown单位：=wdLine，计数：=1
wdApp.Selection.TYPE段落
wdDoc.Range（wdDoc.Characters.Count-1）.可粘贴的False、False、False
wdApp.Selection.Tables（1）.Rows.Alignment=wdAlignRowCenter
wdApp.Selection.Collapse方向：=0
wdDoc.Range（wdDoc.Characters.Count-1）。插入中断类型：=7
其他的
wdDoc.Range（wdDoc.Characters.Count-1）。插入中断类型：=7
如果结束
下一个ws
wdDoc.Styles（“无间距”）.NoSpaceBetweenParagraphsOfSameStyle=True
wdDoc.Save
设置wdDoc=Nothing
设置wdApp=Nothing
Set fromWB=无
MsgBox“导入Word文档”
重置设置：
Application.ScreenUpdating=True
Application.DisplayAlerts=True
Application.EnableEvents=True
端接头
以下是我要使用的代码：

Sub toWord()
Dim ws As Worksheet
Dim fromWB As Variant
Dim wdApp As Object
Dim wdDoc As Object
Dim docName As Variant
Dim rng As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False


Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Add
wdDoc.Activate
'Creates InputBox that allows user to enter name to save document as
docName = Application.InputBox(Prompt:="Enter Document Name", Title:="Save Word Document", Type:=2)
wdDoc.SaveAs2 fileName:=docName, FileFormat:=wdFormatDocument 'Saves document under user-provided name

fromWB = Application.GetOpenFilename(FileFilter:="Excel Workbook(*.xlsx),*.xlsx", Title:="Open Merged Data")
If fromWB <> False Then
Set fromWB = Workbooks.Open(fromWB)
ElseIf fromWB = False Then
    MsgBox "No File Selected"
    GoTo ResetSettings
End If

For Each ws In fromWB.Worksheets
    ws.Activate
    ws.Range("A1:A2").Select
    Selection.Copy
    Set wdApp = GetObject(, "Word.Application")
    wdApp.Visible = True
    wdDoc.Activate
    wdDoc.Range(wdDoc.Characters.Count - 1).Paste

    ws.Activate
    If ws.Range("A4").Value <> "" Then
    Application.Intersect(ws.UsedRange, ws.Cells.Resize(ws.Rows.Count - 2).Offset(2)).Select
    Selection.Columns.AutoFit
    Selection.Copy
    Set wdApp = GetObject(, "Word.Application")
    wdApp.Visible = True
    wdDoc.Activate
    wdApp.Selection.EndKey Unit:=wdStory
    wdApp.Selection.MoveDown Unit:=wdLine, Count:=1
    wdApp.Selection.TypeParagraph
    wdDoc.Range(wdDoc.Characters.Count - 1).PasteExcelTable False, False, False
    wdApp.Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
    wdApp.Selection.Collapse Direction:=0
    wdDoc.Range(wdDoc.Characters.Count - 1).InsertBreak Type:=7
   Else
   wdDoc.Range(wdDoc.Characters.Count - 1).InsertBreak Type:=7
   End If
Next ws

wdDoc.Styles("No Spacing").NoSpaceBetweenParagraphsOfSameStyle = True
wdDoc.Save
Set wdDoc = Nothing
Set wdApp = Nothing
Set fromWB = Nothing
MsgBox "Imported into Word Document"


ResetSettings:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

Sub-toWord（）
将ws设置为工作表
Dim fromWB作为变体
作为对象的应用程序
Dim wdDoc作为对象
Dim docName作为变量
变暗rng As范围
Application.ScreenUpdating=False
Application.DisplayAlerts=False
Application.EnableEvents=False
Set wdApp=CreateObject（“Word.Application”）
wdApp.Visible=True
设置wdDoc=wdApp.Documents.Add
wdDoc.Activate
'创建允许用户输入文档另存为的名称的InputBox
docName=应用程序.InputBox（提示：=“输入文档名称”，标题：=“保存Word文档”，类型：=2）
wdDoc.SaveAs2 fileName:=docName，FileFormat:=wdFormatDocument'以用户提供的名称保存文档
fromWB=Application.GetOpenFilename（文件过滤器：=“Excel工作簿（*.xlsx），*.xlsx”，标题：=“打开合并数据”）
如果fromWB为False，则
Set fromWB=工作簿。打开（fromWB）
ElseIf fromWB=则为False
MsgBox“未选择任何文件”
转到重置设置
如果结束
对于fromWB.工作表中的每个ws
ws.A