Copy selection from excel and paste into Word

[Boblittle]

I have a table sorted by Column E. I am trying to construct a piece of VBA that will go down Column E and where it finds a new code, it will select Columns A:H and paste the contents along with the table headers into a template in word. Save As the template as the subject & Column E, and then move down the list to the next code and repeat.

I have something at the moment but i am a bit of a nube when it comes to this. The errors that i am getting is that i cannot get the Table headers (A1:H1) to be copied along with the Selection- it is either one or the other. I am also getting a warning from Word as it appears to be trying to save as a template.dot and i cant for the life of me work out why, and i also cant work out how to tweake the Save As name to give me subject & Column E reference.

Can someone please please help.

The code i have so far is as follows:

Sub create_email()
' This works by setting the top value as a reference value and
' then comparing the cell below to the reference value, when it
' finds a change it assumes a new email has begun, triggers the
' email and resets the reference value
' define the variables
Dim reference_value As String
Dim reference_cell As Integer
Dim rCur As Range
Dim Email_Text As String
' loop through 1000 cells
For i = 2 To 1000
If Range("E" & i).Value > 0 Then
'set the reference value from the first cell
If i = 2 Then
reference_value = Range("E" & i).Value
reference_cell = Range("E" & i).Row
GoTo skip
End If
'***
If Range("E" & i).Value = reference_value Then
'its the same, do nothing
Else

' its not the same - make a new email
'color it in
Range("E" & reference_cell & ":E" & (i - 1)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
End With

'build the text
Range("A1:H2").Select
Range("A" & reference_cell & ":H" & (i - 1)).Value [(Range."A1:H1")].Select
Selection.Copy
Call CreateNewWordDoc(Range("E" & i).Value)

'reset the reference cells
reference_value = Range("E" & i).Value
reference_cell = Range("E" & i).Row
End If
End If
skip:
Next i
End Sub
Sub CreateNewWordDoc(filename As String)
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open("C:\Documents and Settings\My Documents\Template2.doc")
wrdApp.Selection.GoTo What:=wdGoToBookmark, Name:="Table"
wrdApp.Selection.PasteExcelTable False, False, False

With wrdDoc
If Dir("C:\Documents and Settings\My Documents\test" & filename & "doc") <> "" Then
Kill "("C:\Documents and Settings\My Documents\test" & filename & "doc")"
End If
.SaveAs ("C:\Documents and Settings\My Documents\test" & filename & "doc")
.Close ' close the document
End With
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing
End Sub

Thank you so much in advance

R