Exporting Excel data to word

[bwmustang13]

I am trying to create a list in excel for a list of about 60 items. The list is for people at work to be able to customize reports we print off. I want the user to be able to create 4 customized list of their choosing. I have created a master list of all the possible reports in columns B, E, and H. The user can then cut and paste any items into column L in their preferred order. Although some items in column B are just titles most are referencing a short explanation paragraph in its own worksheet. I am looking to have a VBA command that when executed exports the selected list and the referenced materials, into a new word document. Although I am very proficient with Excel, my VBA skills are meager at best. So if you post a solution please comment out each section so that I can understand the logic. Can anyone point me in the direction of how I can do this? </SPAN></SPAN>
I also need to do several other things:</SPAN></SPAN>

1. I want to be able to keep the data formatted the way it is inputted into the excel document. I don’t want it to change when it goes into word. So for example I have it in 12 point Times New Roman.</SPAN></SPAN></SPAN>
2. I need some but not all cells to have their own heading style and some cells need to continue that style while others will skip it. For example cell B5 heading style might be “1.0 Costs” and cell B8 might be “1.1 Direct Costs” then cell B13 might be “1.2 Indirect Costs”. All of these also need to be added to a table of contents as well.</SPAN></SPAN></SPAN>
3. I need designate that some but not all cells to begin on their own page.</SPAN></SPAN></SPAN>

I was able to do some of of my goals with the folowing code:

Sub main()
Dim objWord As Object
Dim objDoc As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Add
Dim i As Integer
Dim strValue As String
For i = 3 To 49
objDoc.Activate
strValue = Cells(i + 1, 2)
objWord.Selection.TypeText Text:=strValue
objWord.Selection.TypeParagraph
Next i
End Sub</SPAN></SPAN>

 

[Worf]

Hello
I prepared an example:
· It uses tables for better control over the text positioning
· Text formatting is automatically copied
· It assumes the need for a new page is indicated at column K, as shown below

	K	L
new page
new page
new page

<tbody>
[TD="bgcolor: #CACACA, align: center"]1[/TD]

[TD="align: center"]start table 1[/TD]

[TD="bgcolor: #CACACA, align: center"]2[/TD]

[TD="align: center"]1[/TD]

[TD="bgcolor: #CACACA, align: center"]3[/TD]

[TD="align: center"]1[/TD]

[TD="bgcolor: #CACACA, align: center"]4[/TD]

[TD="align: center"]1[/TD]

[TD="bgcolor: #CACACA, align: center"]5[/TD]

[TD="align: center"]end table 1[/TD]

[TD="bgcolor: #CACACA, align: center"]6[/TD]

[TD="align: center"]start table 2[/TD]

[TD="bgcolor: #CACACA, align: center"]7[/TD]

[TD="align: center"]2[/TD]

[TD="bgcolor: #CACACA, align: center"]8[/TD]

[TD="align: center"]2[/TD]

[TD="bgcolor: #CACACA, align: center"]9[/TD]

[TD="align: center"]2[/TD]

[TD="bgcolor: #CACACA, align: center"]10[/TD]

[TD="align: center"]end table 2[/TD]

[TD="bgcolor: #CACACA, align: center"]11[/TD]

[TD="align: center"]start table 3[/TD]

[TD="bgcolor: #CACACA, align: center"]12[/TD]

[TD="align: center"]3[/TD]

[TD="bgcolor: #CACACA, align: center"]13[/TD]

[TD="align: center"]3[/TD]

[TD="bgcolor: #CACACA, align: center"]14[/TD]

[TD="align: center"]3[/TD]

[TD="bgcolor: #CACACA, align: center"]15[/TD]

[TD="align: center"]3[/TD]

[TD="bgcolor: #CACACA, align: center"]16[/TD]

[TD="align: center"]end table 3[/TD]

[TD="bgcolor: #CACACA, align: center"]17[/TD]

[TD="align: center"]start table 4[/TD]

[TD="bgcolor: #CACACA, align: center"]18[/TD]

[TD="align: center"]4[/TD]

[TD="bgcolor: #CACACA, align: center"]19[/TD]

[TD="align: center"]4[/TD]

[TD="bgcolor: #CACACA, align: center"]20[/TD]

[TD="align: center"]end table 4[/TD]

</tbody>

Sub Copy_To_Word()
Dim Lastrow%, fa$, c As Range, st%
Dim AppWord As Word.Application, WordDoc As Word.Document


Lastrow = Range("L" & Rows.Count).End(xlUp).Row
Set AppWord = CreateObject("Word.Application")
Set WordDoc = AppWord.Documents.Add
AppWord.Visible = True
Range("k" & (Lastrow + 1)) = "new page"                     ' to copy last block
With ActiveSheet.Range("k:k")
    Set c = .Find("new page", LookIn:=xlValues)
    If Not c Is Nothing Then
        fa = c.Address
        st = 1
        Do                                                  ' loop the cell blocks
            Range("L" & st & ":L" & (c.Row - 1)).Copy       ' copies previous block
            If st > 1 Then WordDoc.Range(WordDoc.Content.End - 1).InsertBreak Type:=7   ' page break
            WordDoc.Range(WordDoc.Content.End - 1).Paste    ' into Word
            WordDoc.Range.InsertParagraphAfter
            st = c.Row                                      ' starting row
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> fa
    End If
End With
    Application.CutCopyMode = False
    Set AppWord = Nothing
End Sub