Sub SendDataToWord()
  Dim appWord As Word.Application 'need reference to Microsoft Word x.x Object Library
  Dim docWord As Word.Document, rngDoc As Word.Range
  Dim paraWord As Word.Paragraph
  Dim rng As Excel.Range
  Dim i As Integer
  
  Set rng = ActiveSheet.UsedRange
  
  Set appWord = New Word.Application    'Create new instance of Word:
  appWord.Visible = True                'make the Word window visible:
  Set docWord = appWord.Documents.Add   'add a new word document:
  
  For i = 2 To rng.Rows.Count
    Set rngDoc = docWord.Content
    rngDoc.InsertParagraphAfter
    rngDoc.Collapse Direction:=wdCollapseEnd
    rngDoc.Text = rng.Cells(i, 1) & vbCr
    rngDoc.InsertAfter rng.Cells(i, 2)
    rngDoc.Style = "Normal"
    rngDoc.Paragraphs(1).Range.Style = "Heading 2"
    rngDoc.Collapse Direction:=wdCollapseEnd
    docWord.Endnotes.Add Range:=rngDoc, Text:=rng.Cells(i, 3).Text
  Next
End Sub