Space between paragraphs from a cell in wb to bookmark in word.

[molesy01]

Hi
I have had some help from a great guy on this site and he has solved a big problem i had. It was working on importing text from cells in a wb to a template file in word. I have 9 sheets from Section A-I. These sheets contain text which is copied to bookmarks in a word document.

Text is within column E, every other row starting at E10,E12, etc.

The text is within column E, and there are numerous rows. the rows are all even starting at r, E10. All of the text is imported with lookup/array and in sequence which is great. Everything has been achieved and it all works great, however, a small point is, when there is more than 1 cell put into 1 bookmark in word the text from both cells is lumped together like 1 large paragraph, i would like to have a space between each paragraph. For instance, text in E10 and E12 put into bookmark1, with a space between the text. So this would have to be coded for the whole document.

be great if someone could assist. I have included the code below which works great, but without the spacing.

Option Explicit
Sub Button2_click()
Dim objWord As Object, WdStart As Boolean, LastRow As Integer, i As Integer, BCnt As Integer, TBKcnt As Integer
Dim ws As Worksheet, BkMkCnt As Integer, ShtCnt As Integer, RowCnt As Integer, orng As Object
Dim ShtArr() As Variant, BkMkArr() As Variant, TempStr As String, BKName As String, Flag As Boolean
'sheet names
ShtArr = Array("Section A", "Section B", "Section C", "Section D", "Section E", _
"Section F", "Section G", "Section H", "Section I")

'start Word app
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
On Error GoTo 0
Set objWord = CreateObject("Word.Application")
WdStart = True
End If
'open template *********change path to suit
objWord.Visible = False
objWord.Documents.Open "C:\TestFolder\testingbookmarks.docx"

'load bookmarks into an array
ReDim BkMkArr(objWord.activedocument.Bookmarks.Count)
For i = 1 To objWord.activedocument.Bookmarks.Count
BkMkArr(i - 1) = objWord.activedocument.Range.Bookmarks(i)
Next i

'loop sheets
For ShtCnt = LBound(ShtArr) To UBound(ShtArr)
'clear bookmarks
For i = LBound(BkMkArr) To UBound(BkMkArr) - 1
Set orng = objWord.activedocument.Bookmarks(BkMkArr(i)).Range
orng.Text = vbNullString
objWord.activedocument.Bookmarks.Add BkMkArr(i), orng
Next i

'set ws and lastrow "E"
Set ws = ThisWorkbook.Sheets(ShtArr(ShtCnt))
With ws
LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
End With

'loop every other "E" entry (10 to lastrow)
For RowCnt = 10 To LastRow Step 2
TempStr = CStr(ws.Cells(RowCnt, "E"))
BKName = CStr(ws.Cells(RowCnt, "F"))
Flag = False
'if more than one "E" row in same bookmark make string
For BkMkCnt = (RowCnt + 2) To LastRow Step 2
If CStr(ws.Cells(RowCnt, "F")) = CStr(ws.Cells(BkMkCnt, "F")) Then
TempStr = TempStr & Chr(11) & CStr(ws.Cells(BkMkCnt, "E"))
Flag = True
TBKcnt = BkMkCnt
End If
Next BkMkCnt
If Flag Then
RowCnt = TBKcnt '+ 2
End If

'put "E" string in bookmark
With objWord.activedocument
'search for bookmark
For BCnt = LBound(BkMkArr) To UBound(BkMkArr)
If .Bookmarks(BkMkArr(BCnt)) = BKName Then
.Bookmarks(BkMkArr(BCnt)).Range.Text = TempStr
Exit For
End If
Next BCnt
End With

Next RowCnt

'save *********change path to suit
objWord.activedocument.SaveAs2 "C:\TestFolder\Draftreport.docx"
Next ShtCnt


'close template/clean up
objWord.activedocument.Close savechanges:=False
If WdStart Then

Set objWord = Nothing
End If
End Sub