Saving Word documents with Excel Macro

[gabrieljb]

Hi every one;
I take into account to modify my macro code for optimization due to:
My macro creates for each line of the excel file a new document and saves it under the name of the 2nd column of row j .. and as result I 'to get an excel file with 5 lines, 5 word document with multiple users and the number becomes huge! So I would like to assemble in one single word document, I mean, instead of creating a new line for each document, the macro should create a new page in a single document, and as result I would get with only 1 word document 5 pages for an excel file 5 online. is - Can I please??

Sub MacroAutoJB()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim oWdApp As Object

Dim i As Byte
Dim sChemin As String
Dim wb As Workbook

  Dim OutApp As Object
  Dim OutMail As Object
  Dim strbody As String
    
On Error Resume Next
Dim nom As String
Dim sName As String
Dim sPath As String

On Error Resume Next
Dim j As Integer
j = ActiveSheet.UsedRange.Rows.Count 'count number of lines used in the file

Dim n As Byte
n = Cells(1, Columns.Count).End(xlToLeft).Column

If ActiveWorkbook.Name Like "WPaie*.xls" Then

user = Environ("username")
sName = ActiveWorkbook.Name
sPath = "C:\Documents and Settings\" & user & "\My Documents\"
sName = Replace(sName, ".xls", "_Word")
MkDir sName

For j = 2 To j     'start the loop the opeation until the next will be for each line used in the file

Set WordApp = CreateObject("word.application") 
nom = Sheets(1).Cells(j, 2)
mail = Sheets(1).Cells(2, n)

Set oWdApp = CreateObject("Word.Application")
Set WordDoc = oWdApp.Documents.Open("C:\Documents and Settings\" & user & "\Class.doc")

For i = 1 To n - 1
WordDoc.Bookmarks("Sig" & i).Range.Text = Cells(j, i) 
Next i

WordDoc.Bookmarks("Signet").Range.Text = Cells(j, 2)
WordDoc.Bookmarks("Sigmail").Range.Text = Cells(j, n)

WordDoc.SaveAs Filename:=sPath & sName & "\" & nom & ".doc"
WordApp.Visible = False 
oWdApp.Quit
ActiveDocument.Close True
WordApp.Quit 

Next j
ActiveWorkbook.Close