Search code examples
excelvbams-wordcopy-paste

How to copy a selection from word to excel using Word VBA


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!


Solution

  • 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.