Option Explicit
Private Sub CommandButton3_Click()
Const wdSaveChanges = -1
Dim objWordApp As Object
Dim objWordDoc As Object
Dim objWordRange As Object
Dim vntElem As Variant
Dim avntArray As Variant
Dim strText As String, strPath As String
strPath = "C:\Documents\Matchcodes.docx"
Set objWordApp = CreateObject(Class:="Word.Application")
Set objWordDoc = objWordApp.Documents.Open(Filename:=strPath)
Set objWordRange = objWordDoc.Content
With Worksheets("Sheet2")
avntArray = .Cells(2, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)
End With
For Each vntElem In avntArray
strText = strText & vntElem & Chr(10)
Next
objWordRange.InsertAfter Text:=strText
objWordDoc.Close SaveChanges:=wdSaveChanges
objWordApp.Quit
Set objWordApp = Nothing
Set objWordDoc = Nothing
Set objWordRange = Nothing
End Sub