Word 2007 copy content between docs (from Word tables)

[mocha99]

Hi all

I have 2 documents X and Y

The documents have the same structure, they have a 5-column table (Word
tables)

Column A has the same content on both documents.

I move my cursor down the 5th column (column E) in document Y and i need
to use a macro to match the corresponding line (based on the content of
column A which has the same content in both docs) in doc X and copy the
content of Column E in X into Column E in Y.

Example:

Table in DocX contains:
A..........E
cat calico
dog beagle
bird sparrow

Table in DocY:
A..........E
dog <blinking_cursor>


I press my macro key and
Table in DocY becomes:
dog beagle


Can you please help me with this?

Thanks a lot!

 

[Pesach Shelnitz]

Hi,

The following macro asks the user to select a source document (Document X),
copies the contents of the cell in Column E of the first table in Document X
that corresponds to the row in the active document (Document Y) where the
cursor is located according to the contents of Column A, and inserts the
copied text at the cursor in Document Y. Note that if Document X does not
contain any table or if the table has less than 5 rows, an error will be
raised.

Sub CopyFromDocX()
Dim srcDocName As String
Dim srcDoc As Document
Dim trgRange As Range
Dim srcRange As Range
Dim trgText As String
Dim myCell As Cell
Dim i As Integer

With Application.FileDialog(msoFileDialogFilePicker)
If .Show Then
srcDocName = .SelectedItems(1)
Else
MsgBox "You didn't select a source file."
Exit Sub
End If
End With
On Error Resume Next
Set srcDoc = Documents.Open(fileName:=srcDocName, Visible:=False)
If Err.Number <> 0 Then
MsgBox "The file specified could not be opened.", _
vbCritical Or vbOKOnly, "File Not Opened"
Exit Sub
End If
Set trgRange = Selection.Rows(1).Cells(1).Range
With trgRange
.MoveEnd wdCharacter, -1
trgText = .Text
End With
With srcDoc.Tables(1)
For i = 1 To .Rows.Count
Set srcRange = .Rows(i).Cells(1).Range
srcRange.MoveEnd wdCharacter, -1
srcText = srcRange.Text
If srcText = trgText Then
Set srcRange = .Rows(i).Cells(5).Range
srcRange.MoveEnd wdCharacter, -1
srcText = srcRange.Text
Exit For
Else
srcText = ""
End If
Next
End With
Selection.InsertAfter srcText
srcDoc.Close
Set srcDoc = Nothing
Set srcRange = Nothing
Set trgRange = Nothing
Set myCell = Nothing
End Sub