View Single Post
 
Old 06-11-2014, 05:32 PM
macropod's Avatar
macropod macropod is offline Windows 7 32bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,343
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Try the following macro. Add it to your destination document (or to Word's 'Normal' template and activate your destination document), then run it. Select the source document and the destination document will be updated.

Note: I had to change your source row references, plus some destination column references, and you seemed to have too many cells overall. I've also managed to exclude the source table headings.
Code:
Sub XferTblData()
Application.ScreenUpdating = False
Dim DocSrc As Document, TblSrc As Table, RngSrc As Range, RowSrc As String, ColSrc As String
Dim DocTgt As Document, TblTgt As Table, RngTgt As Range, RowTgt As String, ColTgt As String
Dim i As Long
RowSrc = "5,5,6,6,7,7,9,9,11,11"
ColSrc = "1,2,1,2,1,2,1,2,1,2"
RowTgt = "10,10,12,12,14,14,17,17,20,20"
ColTgt = "1,2,1,2,1,2,1,2,2,3"
Set DocTgt = ActiveDocument
With Application.Dialogs(wdDialogFileOpen)
  If .Show = -1 Then
    .AddToMru = False
    .ReadOnly = True
    .Visible = False
    .Update
    Set DocSrc = ActiveDocument
  End If
End With
If DocSrc Is Nothing Then Exit Sub
Set TblSrc = DocSrc.Tables(2)
Set TblTgt = DocTgt.Tables(1)
For i = 0 To UBound(Split(RowSrc, ","))
  Set RngSrc = TblSrc.Cell(Split(RowSrc, ",")(i), Split(ColSrc, ",")(i)).Range
  RngSrc.End = RngSrc.End - 1
  RngSrc.Start = RngSrc.Paragraphs(1).Range.End
  Set RngTgt = TblTgt.Cell(Split(RowTgt, ",")(i), Split(ColTgt, ",")(i)).Range
  RngTgt.End = RngTgt.End - 1
  RngTgt.FormattedText = RngSrc.FormattedText
Next
DocSrc.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote