从excel粘贴到Word文档中 [英] pasting from excel into a word document

查看：118
本文介绍了从excel粘贴到Word文档中的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我正在将Excel中的单元格复制到一个开放的Word文档中.我这样做的方法是将单元格的内容复制到剪贴板中，并替换word文档中的特定关键字，如下所示:

如果单元格A1 = "some word"我也需要替换单词document中的字符串"QUERYA1"

我正在这样做:

Sub NoFormatPaste()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    If IsEmpty(Selection.Text) And Len(Selection.Text) = 0 Then
    ClipEmpty.PutInClipboard
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    End
    Else
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    End If
    CutCopyMode = False

End Sub

该子程序运行时，它将在每个字段上工作，但如果单元格为空则会给出错误.我在单元格中有此公式:=+IF(K10="XXX","",K10)

当此公式产生无"或空白时，运行我的宏时，在将其粘贴到单词中时出现错误.我在此行收到名为4168 command failed/command execution的错误:

appWd.Selection.PasteSpecial DataType:=wdPasteText

这是我完整的代码:

Dim appWd As Word.Application
Dim wdFind As Object
Dim ClipEmpty As New MSForms.DataObject
Dim ClipT As String

Sub FormatPaste()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    If IsEmpty(Selection.Text) And Len(Selection.Text) = 0 Then
    ClipEmpty.PutInClipboard
    appWd.Selection.Paste
    End
    Else
    appWd.Selection.Paste
    End If
    CutCopyMode = False

End Sub

Sub NoFormatPaste()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    If IsEmpty(Selection.Text) And Len(Selection.Text) = 0 Then
    ClipEmpty.PutInClipboard
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    End
    Else
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    End If
    CutCopyMode = False

End Sub

Sub CopyDatatoWord()

Dim docWD As Word.Document
Dim sheet1 As Object
Dim sheet2 As Object
Dim SaveCell1 As String
Dim SaveCell2 As String
Dim SaveCell3 As String
Dim Dir1 As String
Dim Dir2 As String


    Set appWd = CreateObject("Word.Application")
    appWd.Visible = True
    'Set docWD = appWD.Documents.Open("S:\Practice Quarterly Reports\2011 Q1 - V5\Practice Profile Template 2011.docx")
    Set docWD = appWd.Documents.Open("C:\Documents and Settings\jhill\Desktop\Practice Profile Template 2011.docx")

    'Select Sheet where copying from in excel
    Set sheet1 = Sheets("TABLES")
    Set sheet2 = Sheets("REPORT INFO")
    Set wdFind = appWd.Selection.Find
    ClipT = "  "
    ClipEmpty.SetText ClipT

    sheet1.Range("B3:B6").Copy
    wdFind.Text = "Qwerty01"
    Call FormatPaste

    sheet1.Range("B10:B15").Copy
    wdFind.Text = "Qwerty02"
    Call FormatPaste

    sheet1.Range("C21:D28").Copy
    wdFind.Text = "Qwerty03"
    Call FormatPaste

    sheet1.Range("B32:F42").Copy
    wdFind.Text = "Qwerty04"
    Call FormatPaste

    sheet1.Range("B46:D52").Copy
    wdFind.Text = "Qwerty05"
    Call FormatPaste

    sheet1.Range("B58:F68").Copy
    wdFind.Text = "Qwerty06"
    Call FormatPaste

    sheet1.Range("B74:G84").Copy
    wdFind.Text = "Qwerty07"
    Call FormatPaste

    sheet1.Range("B87").Copy
    wdFind.Text = "Qwerty08"
    Call NoFormatPaste

    sheet1.Range("B88").Copy
    wdFind.Text = "Qwerty09"
    Call NoFormatPaste

    sheet1.Range("B89").Copy
    wdFind.Text = "Qwerty10"
    Call NoFormatPaste

    sheet1.Range("B90").Copy
    wdFind.Text = "Qwerty11"
    Call NoFormatPaste

    sheet1.Range("B91").Copy
    wdFind.Text = "Qwerty12"
    Call NoFormatPaste

    sheet1.Range("B92").Copy
    wdFind.Text = "Qwerty13"
    Call NoFormatPaste

    sheet1.Range("B93").Copy
    wdFind.Text = "Qwerty14"
    Call NoFormatPaste

    sheet1.Range("B94").Copy
    wdFind.Text = "Qwerty15"
    Call NoFormatPaste

    sheet2.Range("D4").Copy
    wdFind.Text = "Qwerty16"
    Call NoFormatPaste

    sheet2.Range("B5").Copy
    wdFind.Text = "Qwerty17"
    Call NoFormatPaste


    sheet2.Range("D4").Copy
    wdFind.Text = "Qwerty18"
    Call NoFormatPaste

    sheet2.Range("B8").Copy
    wdFind.Text = "Qwerty19"
    Call NoFormatPaste

    sheet2.Range("B9").Copy
    wdFind.Text = "Qwerty20"
    Call NoFormatPaste

    sheet2.Range("B10").Copy
    wdFind.Text = "Qwerty21"
    Call NoFormatPaste

    sheet2.Range("B11").Copy
    wdFind.Text = "Qwerty22"
    Call NoFormatPaste

    sheet2.Range("B12").Copy
    wdFind.Text = "Qwerty23"
    Call NoFormatPaste

    sheet2.Range("B13").Copy
    wdFind.Text = "Qwerty24"
    Call NoFormatPaste

    sheet2.Range("B14").Copy
    wdFind.Text = "Qwerty25"
    Call NoFormatPaste

    sheet2.Range("B15").Copy
    wdFind.Text = "Qwerty26"
    Call NoFormatPaste

    sheet2.Range("B16").Copy
    wdFind.Text = "Qwerty27"
    Call NoFormatPaste

    sheet2.Range("B17").Copy
    wdFind.Text = "Qwerty28"
    Call NoFormatPaste

    sheet2.Range("B5").Copy
    wdFind.Text = "Qwerty29"
    Call NoFormatPaste

    sheet2.Range("B5").Copy
    wdFind.Text = "Qwerty30"
    Call NoFormatPaste

    sheet2.Range("B5").Copy
    wdFind.Text = "Qwerty31"
    Call NoFormatPaste

    SaveCell1 = sheet2.Range("D3").Text
    SaveCell2 = sheet2.Range("B6").Text
    SaveCell3 = SaveCell2 & "\" & SaveCell1

    Dir1 = "\\annapurna\Shared\Practice Quarterly Reports\2011 Q1 - V5\ & SaveCell2"
    Dir2 = "\\annapurna\Shared\Practice Quarterly Reports\2011 Q1 - V5\ & SaveCell3"


    If Len(Dir1) = False Then
    MkDir Dir1
    End If


    'docWD.SaveAs (Dir2 & ".docx")
    docWD.SaveAs ("\\annapurna\Shared\Practice Quarterly Reports\Q1_2011\Test.docx")

    'appWD.Quit

Set appWd = Nothing
Set docWD = Nothing
Set appXL = Nothing
Set wbXL = Nothing

End Sub

我在做什么错?我仅在空白粘贴上得到错误的原因是什么

解决方案

以下是代码解决方案:

您必须引用countclipboardformats函数来检查剪贴板上是否有任何东西，然后检查是否将空值设置为选择的字符串值.

它似乎是一个故障的MS剪贴板复制和粘贴功能以及剪贴板功能.

Public Declare Function CountClipboardFormats Lib "user32" () As Long

Dim appWd As Word.Application
Dim wdFind As Object
Dim ClipEmpty As New MSForms.DataObject
Dim ClipT As String

Function IsClipboardEmpty() As Boolean
    IsClipboardEmpty = (CountClipboardFormats() = 0)
End Function

Sub CheckClipBrd()

If IsClipboardEmpty() = True Then
ClipEmpty.PutInClipboard
End If
End Sub

Sub FormatPaste()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    Call CheckClipBrd
    appWd.Selection.Paste
    CutCopyMode = False

End Sub

Sub NoFormatPaste()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    Call CheckClipBrd
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    CutCopyMode = False

End Sub

Sub CopyDatatoWord()

Dim docWD As Word.Document
Dim sheet1 As Object
Dim sheet2 As Object
Dim saveCell1 As String
Dim saveCell2 As String
Dim saveCell3 As String
Dim dir1 As String
Dim dir2 As String


    Set appWd = CreateObject("Word.Application")
    appWd.Visible = True
    Set docWD = appWd.Documents.Open("\\annapurna\Shared\Practice Quarterly Reports\Q1_2011\Practice Profile Template 2011.docx")

    'Select Sheet where copying from in excel
    Set sheet1 = Sheets("TABLES")
    Set sheet2 = Sheets("REPORT INFO")
    Set wdFind = appWd.Selection.Find
    ClipT = "  "
    ClipEmpty.SetText ClipT

    sheet1.Range("B3:B6").Copy
    wdFind.Text = "Qwerty01"
    Call FormatPaste

    sheet1.Range("B10:B15").Copy
    wdFind.Text = "Qwerty02"
    Call FormatPaste

    sheet1.Range("C21:D28").Copy
    wdFind.Text = "Qwerty03"
    Call FormatPaste

    sheet1.Range("B32:F42").Copy
    wdFind.Text = "Qwerty04"
    Call FormatPaste

    sheet1.Range("B46:D52").Copy
    wdFind.Text = "Qwerty05"
    Call FormatPaste

    sheet1.Range("B58:F68").Copy
    wdFind.Text = "Qwerty06"
    Call FormatPaste

    sheet1.Range("B74:G84").Copy
    wdFind.Text = "Qwerty07"
    Call FormatPaste

    sheet1.Range("B87").Copy
    wdFind.Text = "Qwerty08"
    Call NoFormatPaste

    sheet1.Range("B88").Copy
    wdFind.Text = "Qwerty09"
    Call NoFormatPaste

    sheet1.Range("B89").Copy
    wdFind.Text = "Qwerty10"
    Call NoFormatPaste

    sheet1.Range("B90").Copy
    wdFind.Text = "Qwerty11"
    Call NoFormatPaste

    sheet1.Range("B91").Copy
    wdFind.Text = "Qwerty12"
    Call NoFormatPaste

    sheet1.Range("B92").Copy
    wdFind.Text = "Qwerty13"
    Call NoFormatPaste

    sheet1.Range("B93").Copy
    wdFind.Text = "Qwerty14"
    Call NoFormatPaste

    sheet1.Range("B94").Copy
    wdFind.Text = "Qwerty15"
    Call NoFormatPaste

    sheet2.Range("D4").Copy
    wdFind.Text = "Qwerty16"
    Call NoFormatPaste

    sheet2.Range("B5").Copy
    wdFind.Text = "Qwerty17"
    Call NoFormatPaste

    sheet2.Range("D4").Copy
    wdFind.Text = "Qwerty18"
    Call NoFormatPaste

    sheet2.Range("B8").Copy
    wdFind.Text = "Qwerty19"
    Call NoFormatPaste

    sheet2.Range("B9").Copy
    wdFind.Text = "Qwerty20"
    Call NoFormatPaste

    sheet2.Range("B10").Copy
    wdFind.Text = "Qwerty21"
    Call NoFormatPaste

    sheet2.Range("B11").Copy
    wdFind.Text = "Qwerty22"
    Call NoFormatPaste

    sheet2.Range("B12").Copy
    wdFind.Text = "Qwerty23"
    Call NoFormatPaste

    sheet2.Range("B13").Copy
    wdFind.Text = "Qwerty24"
    Call NoFormatPaste

    sheet2.Range("B14").Copy
    wdFind.Text = "Qwerty25"
    Call NoFormatPaste

    sheet2.Range("B15").Copy
    wdFind.Text = "Qwerty26"
    Call NoFormatPaste

    sheet2.Range("B16").Copy
    wdFind.Text = "Qwerty27"
    Call NoFormatPaste

    sheet2.Range("B17").Copy
    wdFind.Text = "Qwerty28"
    Call NoFormatPaste

    sheet2.Range("C3").Copy
    wdFind.Text = "Qwerty29"
    Call FormatPaste

    sheet2.Range("C3").Copy
    wdFind.Text = "Qwerty30"
    Call FormatPaste

    sheet2.Range("C3").Copy
    wdFind.Text = "Qwerty31"
    Call FormatPaste

    saveCell1 = sheet2.Range("D3").Text
    saveCell2 = sheet2.Range("B6").Text
    saveCell3 = saveCell2 & "\" & saveCell1

    dir1 = "\\annapurna\Shared\Practice Quarterly Reports\Q1_2011\" & saveCell2
    dir2 = "\\annapurna\Shared\Practice Quarterly Reports\Q1_2011\" & saveCell3


    If Len(dir1) = False Then
    MkDir dir1
    End If


    'docWD.SaveAs (Dir2 & ".docx")
    docWD.SaveAs ("\\annapurna\Shared\Practice Quarterly Reports\Q1_2011\Test.docx")

    'appWD.Quit

Set appWd = Nothing
Set docWD = Nothing
Set appXL = Nothing
Set wbXL = Nothing

End Sub

;)希望对您有所帮助！

i am copying cells from excel into an open word document. the way i am doing this is just copying the contents of a cell into the clipboard and REPLACING a specific KEYWORD in the word document like so:

if cell A1 = "some word" i need too replace the string "QUERYA1" in the word document

i am doing it like this:

Sub NoFormatPaste()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    If IsEmpty(Selection.Text) And Len(Selection.Text) = 0 Then
    ClipEmpty.PutInClipboard
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    End
    Else
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    End If
    CutCopyMode = False

End Sub

when this sub runs, it works on every field except it gives an error if the cell is empty. i have this formula in the cell: =+IF(K10="XXX","",K10)

when this formula yields NOTHING or a blank, and i run my macro, i get an error on PASTING this into word. i am getting an error called 4168 command failed/command execution on this line:

appWd.Selection.PasteSpecial DataType:=wdPasteText

here is my complete code:

Dim appWd As Word.Application
Dim wdFind As Object
Dim ClipEmpty As New MSForms.DataObject
Dim ClipT As String

Sub FormatPaste()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    If IsEmpty(Selection.Text) And Len(Selection.Text) = 0 Then
    ClipEmpty.PutInClipboard
    appWd.Selection.Paste
    End
    Else
    appWd.Selection.Paste
    End If
    CutCopyMode = False

End Sub

Sub NoFormatPaste()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    If IsEmpty(Selection.Text) And Len(Selection.Text) = 0 Then
    ClipEmpty.PutInClipboard
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    End
    Else
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    End If
    CutCopyMode = False

End Sub

Sub CopyDatatoWord()

Dim docWD As Word.Document
Dim sheet1 As Object
Dim sheet2 As Object
Dim SaveCell1 As String
Dim SaveCell2 As String
Dim SaveCell3 As String
Dim Dir1 As String
Dim Dir2 As String


    Set appWd = CreateObject("Word.Application")
    appWd.Visible = True
    'Set docWD = appWD.Documents.Open("S:\Practice Quarterly Reports\2011 Q1 - V5\Practice Profile Template 2011.docx")
    Set docWD = appWd.Documents.Open("C:\Documents and Settings\jhill\Desktop\Practice Profile Template 2011.docx")

    'Select Sheet where copying from in excel
    Set sheet1 = Sheets("TABLES")
    Set sheet2 = Sheets("REPORT INFO")
    Set wdFind = appWd.Selection.Find
    ClipT = "  "
    ClipEmpty.SetText ClipT

    sheet1.Range("B3:B6").Copy
    wdFind.Text = "Qwerty01"
    Call FormatPaste

    sheet1.Range("B10:B15").Copy
    wdFind.Text = "Qwerty02"
    Call FormatPaste

    sheet1.Range("C21:D28").Copy
    wdFind.Text = "Qwerty03"
    Call FormatPaste

    sheet1.Range("B32:F42").Copy
    wdFind.Text = "Qwerty04"
    Call FormatPaste

    sheet1.Range("B46:D52").Copy
    wdFind.Text = "Qwerty05"
    Call FormatPaste

    sheet1.Range("B58:F68").Copy
    wdFind.Text = "Qwerty06"
    Call FormatPaste

    sheet1.Range("B74:G84").Copy
    wdFind.Text = "Qwerty07"
    Call FormatPaste

    sheet1.Range("B87").Copy
    wdFind.Text = "Qwerty08"
    Call NoFormatPaste

    sheet1.Range("B88").Copy
    wdFind.Text = "Qwerty09"
    Call NoFormatPaste

    sheet1.Range("B89").Copy
    wdFind.Text = "Qwerty10"
    Call NoFormatPaste

    sheet1.Range("B90").Copy
    wdFind.Text = "Qwerty11"
    Call NoFormatPaste

    sheet1.Range("B91").Copy
    wdFind.Text = "Qwerty12"
    Call NoFormatPaste

    sheet1.Range("B92").Copy
    wdFind.Text = "Qwerty13"
    Call NoFormatPaste

    sheet1.Range("B93").Copy
    wdFind.Text = "Qwerty14"
    Call NoFormatPaste

    sheet1.Range("B94").Copy
    wdFind.Text = "Qwerty15"
    Call NoFormatPaste

    sheet2.Range("D4").Copy
    wdFind.Text = "Qwerty16"
    Call NoFormatPaste

    sheet2.Range("B5").Copy
    wdFind.Text = "Qwerty17"
    Call NoFormatPaste


    sheet2.Range("D4").Copy
    wdFind.Text = "Qwerty18"
    Call NoFormatPaste

    sheet2.Range("B8").Copy
    wdFind.Text = "Qwerty19"
    Call NoFormatPaste

    sheet2.Range("B9").Copy
    wdFind.Text = "Qwerty20"
    Call NoFormatPaste

    sheet2.Range("B10").Copy
    wdFind.Text = "Qwerty21"
    Call NoFormatPaste

    sheet2.Range("B11").Copy
    wdFind.Text = "Qwerty22"
    Call NoFormatPaste

    sheet2.Range("B12").Copy
    wdFind.Text = "Qwerty23"
    Call NoFormatPaste

    sheet2.Range("B13").Copy
    wdFind.Text = "Qwerty24"
    Call NoFormatPaste

    sheet2.Range("B14").Copy
    wdFind.Text = "Qwerty25"
    Call NoFormatPaste

    sheet2.Range("B15").Copy
    wdFind.Text = "Qwerty26"
    Call NoFormatPaste

    sheet2.Range("B16").Copy
    wdFind.Text = "Qwerty27"
    Call NoFormatPaste

    sheet2.Range("B17").Copy
    wdFind.Text = "Qwerty28"
    Call NoFormatPaste

    sheet2.Range("B5").Copy
    wdFind.Text = "Qwerty29"
    Call NoFormatPaste

    sheet2.Range("B5").Copy
    wdFind.Text = "Qwerty30"
    Call NoFormatPaste

    sheet2.Range("B5").Copy
    wdFind.Text = "Qwerty31"
    Call NoFormatPaste

    SaveCell1 = sheet2.Range("D3").Text
    SaveCell2 = sheet2.Range("B6").Text
    SaveCell3 = SaveCell2 & "\" & SaveCell1

    Dir1 = "\\annapurna\Shared\Practice Quarterly Reports\2011 Q1 - V5\ & SaveCell2"
    Dir2 = "\\annapurna\Shared\Practice Quarterly Reports\2011 Q1 - V5\ & SaveCell3"


    If Len(Dir1) = False Then
    MkDir Dir1
    End If


    'docWD.SaveAs (Dir2 & ".docx")
    docWD.SaveAs ("\\annapurna\Shared\Practice Quarterly Reports\Q1_2011\Test.docx")

    'appWD.Quit

Set appWd = Nothing
Set docWD = Nothing
Set appXL = Nothing
Set wbXL = Nothing

End Sub

what am i doing wrong? what is the reason i get an error only on the paste of a blank

解决方案

Here is the code solution:

You had to reference the countclipboardformats function to check if there was anything on the clipboard and then if empty set to a string value chosen.

It appears to be a glitch MS clipboard copy and paste function and the clipboard function.

Public Declare Function CountClipboardFormats Lib "user32" () As Long

Dim appWd As Word.Application
Dim wdFind As Object
Dim ClipEmpty As New MSForms.DataObject
Dim ClipT As String

Function IsClipboardEmpty() As Boolean
    IsClipboardEmpty = (CountClipboardFormats() = 0)
End Function

Sub CheckClipBrd()

If IsClipboardEmpty() = True Then
ClipEmpty.PutInClipboard
End If
End Sub

Sub FormatPaste()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    Call CheckClipBrd
    appWd.Selection.Paste
    CutCopyMode = False

End Sub

Sub NoFormatPaste()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    Call CheckClipBrd
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    CutCopyMode = False

End Sub

Sub CopyDatatoWord()

Dim docWD As Word.Document
Dim sheet1 As Object
Dim sheet2 As Object
Dim saveCell1 As String
Dim saveCell2 As String
Dim saveCell3 As String
Dim dir1 As String
Dim dir2 As String


    Set appWd = CreateObject("Word.Application")
    appWd.Visible = True
    Set docWD = appWd.Documents.Open("\\annapurna\Shared\Practice Quarterly Reports\Q1_2011\Practice Profile Template 2011.docx")

    'Select Sheet where copying from in excel
    Set sheet1 = Sheets("TABLES")
    Set sheet2 = Sheets("REPORT INFO")
    Set wdFind = appWd.Selection.Find
    ClipT = "  "
    ClipEmpty.SetText ClipT

    sheet1.Range("B3:B6").Copy
    wdFind.Text = "Qwerty01"
    Call FormatPaste

    sheet1.Range("B10:B15").Copy
    wdFind.Text = "Qwerty02"
    Call FormatPaste

    sheet1.Range("C21:D28").Copy
    wdFind.Text = "Qwerty03"
    Call FormatPaste

    sheet1.Range("B32:F42").Copy
    wdFind.Text = "Qwerty04"
    Call FormatPaste

    sheet1.Range("B46:D52").Copy
    wdFind.Text = "Qwerty05"
    Call FormatPaste

    sheet1.Range("B58:F68").Copy
    wdFind.Text = "Qwerty06"
    Call FormatPaste

    sheet1.Range("B74:G84").Copy
    wdFind.Text = "Qwerty07"
    Call FormatPaste

    sheet1.Range("B87").Copy
    wdFind.Text = "Qwerty08"
    Call NoFormatPaste

    sheet1.Range("B88").Copy
    wdFind.Text = "Qwerty09"
    Call NoFormatPaste

    sheet1.Range("B89").Copy
    wdFind.Text = "Qwerty10"
    Call NoFormatPaste

    sheet1.Range("B90").Copy
    wdFind.Text = "Qwerty11"
    Call NoFormatPaste

    sheet1.Range("B91").Copy
    wdFind.Text = "Qwerty12"
    Call NoFormatPaste

    sheet1.Range("B92").Copy
    wdFind.Text = "Qwerty13"
    Call NoFormatPaste

    sheet1.Range("B93").Copy
    wdFind.Text = "Qwerty14"
    Call NoFormatPaste

    sheet1.Range("B94").Copy
    wdFind.Text = "Qwerty15"
    Call NoFormatPaste

    sheet2.Range("D4").Copy
    wdFind.Text = "Qwerty16"
    Call NoFormatPaste

    sheet2.Range("B5").Copy
    wdFind.Text = "Qwerty17"
    Call NoFormatPaste

    sheet2.Range("D4").Copy
    wdFind.Text = "Qwerty18"
    Call NoFormatPaste

    sheet2.Range("B8").Copy
    wdFind.Text = "Qwerty19"
    Call NoFormatPaste

    sheet2.Range("B9").Copy
    wdFind.Text = "Qwerty20"
    Call NoFormatPaste

    sheet2.Range("B10").Copy
    wdFind.Text = "Qwerty21"
    Call NoFormatPaste

    sheet2.Range("B11").Copy
    wdFind.Text = "Qwerty22"
    Call NoFormatPaste

    sheet2.Range("B12").Copy
    wdFind.Text = "Qwerty23"
    Call NoFormatPaste

    sheet2.Range("B13").Copy
    wdFind.Text = "Qwerty24"
    Call NoFormatPaste

    sheet2.Range("B14").Copy
    wdFind.Text = "Qwerty25"
    Call NoFormatPaste

    sheet2.Range("B15").Copy
    wdFind.Text = "Qwerty26"
    Call NoFormatPaste

    sheet2.Range("B16").Copy
    wdFind.Text = "Qwerty27"
    Call NoFormatPaste

    sheet2.Range("B17").Copy
    wdFind.Text = "Qwerty28"
    Call NoFormatPaste

    sheet2.Range("C3").Copy
    wdFind.Text = "Qwerty29"
    Call FormatPaste

    sheet2.Range("C3").Copy
    wdFind.Text = "Qwerty30"
    Call FormatPaste

    sheet2.Range("C3").Copy
    wdFind.Text = "Qwerty31"
    Call FormatPaste

    saveCell1 = sheet2.Range("D3").Text
    saveCell2 = sheet2.Range("B6").Text
    saveCell3 = saveCell2 & "\" & saveCell1

    dir1 = "\\annapurna\Shared\Practice Quarterly Reports\Q1_2011\" & saveCell2
    dir2 = "\\annapurna\Shared\Practice Quarterly Reports\Q1_2011\" & saveCell3


    If Len(dir1) = False Then
    MkDir dir1
    End If


    'docWD.SaveAs (Dir2 & ".docx")
    docWD.SaveAs ("\\annapurna\Shared\Practice Quarterly Reports\Q1_2011\Test.docx")

    'appWD.Quit

Set appWd = Nothing
Set docWD = Nothing
Set appXL = Nothing
Set wbXL = Nothing

End Sub

;) Hope this helps!

这篇关于从excel粘贴到Word文档中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
其他开发最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆