title: How to paste values on every page of word document from Excel VBA?
body: <p>I have a long list of word-paths and start- and endtags in Excel. I need to open the word document using the path specified in Excel, and paste a start-tag on the beginning of every page, and an end-tag on every end of a page. Every document has three pages.
  I'm struggling with Excel VBA and cant seem to get it to work. Can anyone help me?</p>
  <p>I need my code to run through the list, opening the file, copy the starttag on the beginning of each page, and the end tag on the end of each page, save and close the document and go on to the next document.</p>
  <p><a href="https://i.stack.imgur.com/tnXXL.png" rel="nofollow noreferrer">My excel structure</a></p>
  <p>Until now, I managed to open my excel document</p>
  <pre><code>Sub startword()
      Set WordApp = CreateObject(&quot;word.Application&quot;)
      Path = Range(&quot;B2&quot;).Value &amp; Range(&quot;F5&quot;).Value
          WordApp.Documents.Open Path
          
          WordApp.Visible = True
  End Sub
  </code></pre>
  <p>And I was able to copy and paste values to a NEW document.</p>
  <pre><code>Sub copyrange()
  
      'declare word vars
      Dim WrdApp As Word.Application
      Dim WrdDoc As Word.Document
      'Path = Range(&quot;B2&quot;).Value &amp; Range(&quot;F5&quot;).Value
      
      'declare excel vars
      Dim ExcRng As Range
      
      'create new word instance
      Set WrdApp = New Word.Application
          WrdApp.Visible = True
          WrdApp.Activate
          
      Set WrdDoc = WrdApp.Documents.Add
      
      
      
      'create reference to range i want to copy
      Set ExcRng = ActiveSheet.Range(&quot;B2:E6&quot;)
      
      'copy the range and wait for a bit
      ExcRng.Copy
      Application.Wait Now() + #12:00:01 AM#
      
      'paste the object in word
      WrdDoc.Paragraphs(1).Range.PasteExcelTable LinkedToExcel:=True, WordFormatting:=True, RTF:=False
      
        WrdApp.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
        
         WrdDoc.Paragraphs(1).Range.PasteSpecial Link:=True, DataType:=wdPasteOLEObject
      
      'clear clipboard
      Application.CutCopyMode = False
  
  End Sub
  </code></pre>
  <p>The range is totally random</p>
  <p><strong>PART TWO OF THE QUESTION</strong>
  I'm struggling with the next piece of my code. I need to extract the contents between the first start and end tag (with the tag included) and move them to doc 1, same with page 2 to doc2, page 3 to doc 3. So I'll get three documents. doc1 with all the first pages of my documents, doc 2 with all the 2nd pages etc. I've made an attempt to find/select the code, but it selects the first and the last page, not the first one.</p>
  <p>This is my current code for opening the word docs one by one:</p>
  <pre><code>Sub SelectRangeBetween()
  
      Dim ws As Worksheet
      Set ws = ThisWorkbook.Sheets(&quot;Sheet1&quot;)                  'Change to the correct sheetname
  
      Dim wrdApp As Word.Application
      Dim WrdDoc As Word.Document
      
      Set wrdApp = New Word.Application                       '
      wrdApp.Visible = True                                   'set to false for higher speed
        
      
      Const StarttagColumn = &quot;C&quot;                              'Edit this for the column of the starttag.
      Const EndtagColumn = &quot;D&quot;                                'Edit this for the column of the endtag.
      Const FilelocationColumn = &quot;E&quot;                          'Edit this for the column of the Filelocation.
      Const startRow As Long = 5                              'This is the first row of tags and filenames
      'Const endRow As Long = 140                             'uncomment if you want a fixed amount of rows (for ranges with empty cells)
      Dim endRow As Long                                      'comment out if const-endrow is used
      endRow = ws.Range(&quot;B&quot; &amp; Rows.Count).End(xlUp).Row       'comment out if const-endrow is used
  
       Dim i As Long
       For i = startRow To endRow
          Dim wrdPath As String
          wrdPath = ws.Cells(i, FilelocationColumn).Value2    '
          
          If wrdPath &lt;&gt; vbNullString Then                     '
              If Dir(wrdPath) &lt;&gt; vbNullString Then            '
                  Dim startTag As String                      '
                  Dim endTag As String                        '
                  
                  startTag = ws.Cells(i, StarttagColumn).Value2   '
                  endTag = ws.Cells(i, EndtagColumn).Value2       '
                  
                  Set WrdDoc = wrdApp.Documents.Open(wrdPath) '
              With wrdApp
              '.Documents.Add
              ' .Visible = True
              ' Types the text
              '.Selection.HomeKey Unit:=wdStory
              '.Selection.TypeText Text:=&quot;Hello and Goodbye&quot;
              ' The Real script
              'Dim StartWord As String, EndWord As String
              'StartWord = &quot;Hello&quot;
              'EndWord = &quot;Goodbye&quot;
              With .ActiveDocument.Content.Duplicate
               .Find.Execute FindText:=startTag &amp; &quot;*&quot; &amp; endTag, MatchWildcards:=False
               .MoveStart wdCharacter, Len(StardWord)
               .MoveEnd wdCharacter, -Len(EndWord)
               .Select ' Or whatever you want to do
              End With
              
              End With
              With WrdDoc
              .Close
              End With
              End If
          End If
      Next i
  End Sub
  </code></pre>