VBA code to copy and create n number of word documents from excel range

[skonduru]

Hi all,

I am pretty new in VBA coding for word documents. I am trying to come up with a VBA code to copy and create n number of word documents from excel range (for example, say excel spreadsheet has 100 items in range A, i would like to loop through the range in column A and copy and create 100 word documents).

After creating say 1st document, i would like to loop through a particular row and fill the text form fields in newly created word document with the values in row 2. Say i have 20 columns with data for each item.

Any help will be greatly appreciated.

Thanks and regards,

Kon.

[jraj1106]

Hi
Post the excel file which has to be copied into word.

[skonduru]

Hi jraj1106,

Thanks for the reply. Attached are the word and spreadsheet templates. I have a word document filled out of 1st structure. I would like to create the 12 copies of this word documents and fill out the text form fields with the data from spreadsheet (order of the fields in word are from top to bottom and in some sequential order).

Thanks alot.

[skonduru]

Hi All,

I was able to figure out the code and below is the final outcome for your reference:

Sub CreateSheets()

    Dim wdApp As Object
    Dim ProjectPath As String
    Dim odocument As Word.Document
    Dim i As Long, j As Long
    Dim lFirstRow As Long, lFirstCol As Long, lLastRow As Long, lLastCol As Long

    With ActiveSheet.UsedRange
        lFirstRow = .Row
        lFirstCol = .Column
        lLastRow = .Rows(UBound(.Value)).Row
        lLastCol = .Columns(UBound(.Value, 2)).Column
    End With
    
    ProjectPath = ActiveWorkbook.Path & "\"
    
     'Open Word Instance
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False
    
    Dim strTemplateName As String
    strTemplateName = ProjectPath & "Sample Data.dot"
     
    For j = 4 To lLastRow
        
        On Error Resume Next
        Kill ProjectPath & "Str " & Cells(j, 3) & ".doc"
        
        Set odocument = wdApp.Documents.Add(strTemplateName, False, , True)
        
        With wdApp.ActiveDocument
            'Prefill Data
            For i = 1 To lLastCol
                .FormFields("FormField" & i).Result = Cells(j, i)
            Next
        End With
        
        odocument.SaveAs ProjectPath & "Str " & Cells(j, 3), wdFormatDocument97
        odocument.Close
    
    Next
     
     'Clear
    Set wdApp = Nothing
    
    MsgBox "Created " & lLastRow - 3 & " Foundation Data Sheets"
    
End Sub