如何使用Word VBA将选择内容从Word复制到Excel

Question

I'm trying to copy word(s) from my word document to a specific cell in the excel workbook. I've used Bookmark to find the text i need and copy that then i open the workbook to paste to a specific cell - which is a vlookup reference.

My code runs but the pasting does not actually occur. I know the copy portion of the code works because when i run up until that point then manually paste the selection, it works just fine. I've tried multiple options of pasting but nothing has worked so far...

Selection. Paste

Selection.PasteSpecial (xlPasteAll)

Selection.PasteSpecial (xlPasteValues)

Here is my code:

Sub copypastewordtoexcel()

Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String

ActiveDocument.Bookmarks("Name").Select
Selection.Copy

WorkbookToWorkOn = "C:\Users\arboari\Desktop\Book1.xlsx"

Set oXL = GetObject(, "Excel.Application")

Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)

ActiveDocument.Bookmarks("Name").Select
Selection.Copy

For Each oSheet In oXL.ActiveWorkbook.Worksheets
oSheet.Range("A1").Select
Selection.PasteSpecial (xlPasteValue)
Next oSheet

Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing

End Sub

I'm not sure what i'm doing wrong but i'd appreciate some guidance on this!

Thanks!

Answer 1

Should not need copy/paste: you can assign directly

Sub copypastewordtoexcel()

    Dim oXL As Excel.Application
    Dim oWB As Excel.Workbook
    Dim oSheet As Excel.Worksheet
    Dim ExcelWasNotRunning As Boolean
    Dim WorkbookToWorkOn As String

    WorkbookToWorkOn = "C:\Users\arboari\Desktop\Book1.xlsx"

    Set oXL = GetObject(, "Excel.Application")
    Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)

    For Each oSheet In oXL.ActiveWorkbook.Worksheets
            oSheet.Range("A1").Value = ActiveDocument.Bookmarks("Name").Range.Text
    Next oSheet

End Sub

EDIT: reading from a table cell

txt = ActiveDocument.Tables(1).Cell(1, 1).Range.Text
oSheet.Range("A1").Value = Left(txt, Len(txt)-2)

You need to strip off the two-character "end of cell" marker.