VBA word restart numbering at 1after each heading - vba

Question

I have a piece of code for a word document that reads its own table of contents and then searches a particular folder for a word document related to each heading. It then copies the contents and pastes it under the appropriate heading. However, these pieces of text are in the form of a numbers list and when they are pasted in, the numbering continues from the previous heading and won't restart at 1. I have tried a few different pieces of code, which I found my recording a macro and I had it where it changed the first number but then from the second number it continued from the last. I feel that I probably need a loop to iterate through the numbers list but I am not sure how to implement this. I would really appreciate any help with this as I am out of ideas.
Thank you in advance!
Robbie
Sub InsertRoomDocumentFile()
'Declare variables
Dim a As String
Dim header As String
Dim f As String
Dim sourceDocument As Document
Dim tocItems As Variant
Dim myField As Field
Set sourceDocument = ActiveDocument
'Call Table of contents function
tocItems = GetTOCItems
a = "\\HEADFOP002V\ST_Dolan_R$\windows\Desktop\"
f = ".docx"
'Print table of contents to window
counter = 0
For Each myField In sourceDocument.TablesOfContents(1).Range.Fields
'Debug.Print myField.result.Text ', Chr(13), "-") & " " & " Type: " & myField.Type
If counter <> 0 Then
header = myField.result.Text
Debug.Print header
Total = a + header + f
Documents.Open FileName:=Total, ReadOnly:=True
Set myWindow = Windows(1)
winNum = myWindow.Index
If Windows.Count >= 2 Then
ActiveDocument.Range(0, 0).Select
Selection.WholeStory
ActiveDocument.Range(WholeStory).Copy
myWindow.Close
If counter = 1 Then
Selection.GoTo What:=wdGoToHeading, Which:=wdGoToFirst
Selection.GoTo What:=wdGoToLine, Which:=wdGoToRelative, Count:=1
Else
Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext
Selection.GoTo What:=wdGoToLine, Which:=wdGoToRelative, Count:=1
End If
Selection.Range.Paste
End If
End If
DoEvents
counter = counter + 1
Next
End Sub
This is the macro I recorded to restart the numbering. I have included the Selection.Range.Paste line to show you where I put it into my code.
Selection.Range.Paste 'Paste the copied file under the appropriate heading
With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
.NumberFormat = "(%1)"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(-1.27)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(-0.27)
.TabPosition = wdUndefined
.ResetOnHigher = 0
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = wdUndefined
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = ""
End With
.LinkedStyle = ""
End With
ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
Selection.Range.ListFormat.ApplyListTemplate ListTemplate:= _
ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:= _
False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior