But for the anomaly that there are 20 codes and only 19 sets of 0s the following will do the job (using the first 19 in the order they appear in the document):
Code:
Sub Replace0s()
Dim oSource As Document
Dim oTarget As Document
Dim oDoc As Document
Dim oRng As Range
Dim oPara As Range
Dim Count As Long
Dim i As Long
'Open the two documents first
For Each oDoc In Documents
If oDoc.name = "QDGGHR3YXNQ2WFLDB976.docx" Then
Set oSource = oDoc
ElseIf oDoc.name = "9780176679903_rathus2ce_mc_ch01.docx" Then
Set oTarget = oDoc
End If
Next oDoc
Count = 0
Set oRng = oTarget.Range
With oRng.Find
Do While .Execute(FindText:="00000000000000000000")
Count = Count + 1
Set oPara = oSource.Paragraphs(Count).Range
oPara.End = oPara.End - 1
oRng.Text = oPara.Text
oRng.Collapse 0
Loop
End With
End Sub