Macro to Copy from Specific Cells in Word Table to Excel

[EnginerdUNH]

Hi,

I have a form (attached) that was created in Word which contains several rows which have different numbers of columns due to some of the rows having multiple or all of the columns merged together. I need to take the information that is entered into the cells that are highlighted in yellow and copy them into an Excel file which is set up to correspond to the rows in the Word file.

When I copy the information manually, it copies and pastes into the correct cells in the Excel file. Since this form will need to be used quite frequently by a variety of people, manually copying and pasting the information every time would be tedious and possibly lead to copy errors. Therefore, I need to write a macro which will do the same thing that I'm currently able to do manually. The issue that I'm running into is that I cannot seem to figure out how to write the macro to copy/paste the highlighted cells all at once.

I know could have simplified the process significantly by creating the form in excel rather than word but the people who will be using the form are not Excel savvy and their request was that the form be created as a Word document. Any suggestions?

[HansV]

1) Do you want the macro to be run in Word or in Excel?
2) Should the yellow cells be copied to a single column in the Excel workbook? If so, into column A? Or ...?

[robertocm]

An idea would be to insert Content Controls inside the table cells, and read values from excel VBA

http://www2.westsussex.gov.uk/Learninga ... forms.pdf
https://support.microsoft.com/en-us/off ... 2f732c8c8b
https://stackoverflow.com/questions/295 ... d-to-excel
https://stackoverflow.com/questions/673 ... rd-via-vba
https://www.msofficeforums.com/word-vba ... value.html
https://gregmaxey.com/word_tip_pages/co ... trols.html
http://gregmaxey.com/word_tip_pages/con ... tions.html

[EnginerdUNH]

1) Do you want the macro to be run in Word or in Excel?
2) Should the yellow cells be copied to a single column in the Excel workbook? If so, into column A? Or ...?

Hi Hans,

Here's the answer to your questions:
1. The macro should be run in Word
2. The yellow cells are all being copied to a single column in the Excel workbook and the column will change each time new data is copied in. However, I need to provide a correction to my OP. Based on talking with the people who will be using the form, all I would like the macro to do is copy all of the highlighted cells and then the data will be manually pasted into the column in the workbook specified by the user.

[HansV]

The structure of the table is very unfortunate for this purpose, so the macro below is a bit of a kludge.
If it runs to completion, you'll end up with a column in Excel that has been copied, ready to be pasted elsewhere.

Code: Select all

Sub CopyCells()
    Dim tb As Table
    Dim rw As Row
    Dim r As Long
    Dim s As String
    Dim v(2 To 91, 1 To 1) As Variant
    Dim xlApp As Object
    Dim xlWbk As Object
    Dim xlWsh As Object
    On Error Resume Next
    Set xlApp = GetObject(Class:="Excel.Application")
    On Error GoTo 0 ' ErrHandler
    If xlApp Is Nothing Then
        Set xlApp = CreateObject(Class:="Excel.Application")
        xlApp.Visible = True
    End If
    xlApp.ScreenUpdating = False
    Set xlWbk = xlApp.Workbooks.Add(Template:=-4167)
    Set xlWsh = xlWbk.Worksheets(1)
    Set tb = ActiveDocument.Tables(1)
    tb.Cell(2, 2).Select
    For r = 2 To 91
        s = Selection.Text
        v(r, 1) = Left(s, Len(s) - 2)
        If r = 39 Then
            tb.Cell(40, 3).Select
        Else
            Selection.MoveDown Unit:=wdLine
            Selection.Cells(1).Select
        End If
    Next r
    xlWsh.Range("A1:A90").Value = v
    xlWsh.Range("A1:A90").Copy
ExitHandler:
    xlApp.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[EnginerdUNH]

Hi Hans,

I tested the code you provided and it does work however there is one problem. The Excel spreadsheet that the data needs to be pasted into will have multiple sheets where the data could be pasted and the exact sheet (and column) where everything needs to be pasted into will change. Is it possible to modify the code you provided such that all it does is copy the data from the highlighted columns and then the user will just manually paste the data into the sheet/column they choose?

[HansV]

That would be difficult since we cannot simply copy the cells from the Word table because of its complicated structure.

[snb]

I'd use

Code: Select all

Sub M_snb()
   For Each it In Tables(1).Range.Cells
     If it.Range.Shading.BackgroundPatternColor = vbYellow Then c00 = c00 & vbLf & it.Range.Text
   Next
   sn=split(mid(c00,2),vblf)
   
   with getobject("G:\OF\goal.xlsx")
     .sheets(1).cells(1).resize(ubound(sn)+1)=.application.transpose(sn)
   end with
End Sub