Sub
MailMergePropagateLabel()
Dim atable As Table
Dim i As Long
Dim j
As Long
Dim source As
Cell
Dim
target As Cell
Dim myrange As Range
Set atable = ActiveDocument.Tables(1)
Set
source = atable.Cell(1, 1)
Set myrange = source.Range
myrange.Collapse wdCollapseStart
ActiveDocument.Fields.Add Range:=myrange, Text:="NEXT",
_
PreserveFormatting:=False
source.Range.Copy
For
j = 2 To atable.Columns.Count
Set target = atable.Cell(1,
j)
If target.Range.Fields.Count > 0
Then
target.Range.Paste
End If
Next
j
For i = 2 To atable.Rows.Count
For j = 1
To atable.Columns.Count
Set target = atable.Cell(i, j)
If target.Range.Fields.Count > 0
Then
target.Range.Paste
End If
Next j
Next i
atable.Cell(1, 1).Range.Fields(1).Delete
End
Sub