![]() |
#3
|
||||
|
||||
![]()
Not inappropriate, just no-one got around to it
![]() Based on your illustration, and assuming the list document is consistent in its formatting and all the numbers are prefixed 'US', the following macro should work for you. Change the names and paths of the two documents to reflect what you have. If you don't want the formatting in the table to match the formatting in the list, then replace the two instances of 'formattedtext' with 'text' http://www.gmayor.com/installing_macro.htm Code:
Option Explicit Sub UpdateTable() Dim oSource As Document Dim oTarget As Document Dim oRng As Range Dim strFind As String 'Open the document with the table Set oTarget = Documents.Open("C:\Path\EN\Target.docx") 'Open the document with the list Set oSource = Documents.Open("C:\Path\EN\Source.docx") Set oRng = oSource.Range With oRng.Find With oRng.Find Do While .Execute(FindText:="US[0-9]{5,}", _ MatchWildcards:=True) 'The number as shown in the list document strFind = Trim(Replace(oRng.Text, "US", "")) 'Remove the 'US' Prefix from the found number oRng.MoveEnd wdParagraph, 5 'Move the end of the range that encompasses the found text the end of the required text oRng.MoveStart wdParagraph, 1 'Move the start of the range to start of the paragraph after the paragraph with the found text FillTable oTarget, oRng, strFind 'Call the sub to fill the table with the text from the range oRng.Collapse 0 Loop End With End With lbl_Exit: Set oSource = Nothing Set oTarget = Nothing Set oRng = Nothing Exit Sub End Sub Private Sub FillTable(oDoc As Document, _ oRng As Range, _ strFind As String) Dim oCell As Range Dim oFind As Range Dim iRow As Long Set oFind = oDoc.Range With oFind.Find Do While .Execute(FindText:=strFind) iRow = oFind.Information(wdEndOfRangeRowNumber) Set oCell = oDoc.Tables(1).Rows(iRow).Cells(5).Range oCell.End = oCell.End - 1 oCell.FormattedText = oRng.FormattedText 'use this line to keep the formatting 'oCell.Text = oRng.Text 'use this line if the formatting is not required Exit Do Loop End With lbl_Exit: Set oCell = Nothing Set oFind = Nothing Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
Tags |
data merge, ms word 2010, vba code |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
search on multiple word documents | Guy Roth | Word | 7 | 03-06-2017 01:31 PM |
![]() |
NovaScotia | Word | 4 | 01-21-2015 11:44 PM |
![]() |
beirput | Word | 3 | 11-10-2014 02:53 AM |
![]() |
Cimballi | Word | 3 | 07-01-2014 03:45 AM |
How to preserve or Retain bookmarks during Merging of word documents | ramsgarla | Word | 2 | 09-18-2012 08:59 AM |