How do I copy a table cell containing a list, and restart the numbering?

Question

I have some text in a table. The first row is populated with some template text. See screenshot below:

I want to copy this row, keeping all formatting, and restart the list from 1. See screenshot of expected result:

For this toy example, I wrote the following code:

Sub copyTableData()

    Tables(1).Cell(1, 2).Range.FormattedText.Copy

    Tables(1).Cell(2, 2).Range.FormattedText.PasteAndFormat (wdListRestartNumbering)
End Sub

This retains the formatting, but the numbering continues from the first cell, despite using the option wdListRestartNumbering. Also, for some reason, the last list item is not numbered. See screenshot below of the result after running the copyTableData() function:

Answer 1

These are conjectures on my part:

• In this case the wdListRestartNumbering option only applies to the last paragraph that's copied.
• If the last numbered paragraph comes immediately before the end of cell marker, then the paragraph numbering is lost when you paste (This looks a bit like an error in Word because other paragraph formatting is copied).
• When you copy and paste the list, all the paragraphs in the new list are in the same list as the original list. There, doing something like resetting the new list's start number to 1 only affects that paragraph as the other paragraphs in the list remain in the original list.

The following code seems to deal with all those things in this particular situation, but if for example you have more than one list you would have to do more.

I certainly hope that there is a much simpler solution.

Sub copyTableDataExample()

Dim p As Word.Paragraph
Dim r As Word.Range
Dim s As Word.Range
With ActiveDocument
  Set r = .Tables(1).Cell(1, 2).Range
  r.InsertParagraphAfter
  ' If you "copy" the end of cell marker, the data may end up in the wrong cell, so adjust the end of Range
  r.End = r.End - 1
  Set s = .Tables(1).Cell(2, 2).Range
  ' Copy
  s.FormattedText = r.FormattedText
  ' Remove the paras we inserted
  r.Characters(r.Characters.Count).Delete
  Set r = Nothing
  s.Characters(s.Characters.Count - 1).Delete
  
  ' look for the first paragraph in a list and split the list
  For Each p In s.Paragraphs
    If p.Range.ListParagraphs.Count = 1 Then
      p.SeparateList
      Exit For
    End If
  Next
  Set s = Nothing
  End With
End Sub