Show Buttons
Share On Facebook
Share On Twitter
Share On Google Plus
Share On Linkdin
Share On Reddit
Contact us
Hide Buttons

VBA-Excel — Merger — Merge or Combine Many Word Documents Into One

Down­load Link:Word­Merger

If you want to com­bine or merger many word doc­u­ment into one file and you don’t want to do it man­u­ally, This piece of soft­ware will allow you merge as many word doc­u­ment you want, say 500‑1000 word doc­u­ments. This tool will pro­vide you to option to select ot de-select word doc­u­ments before merging.

How to Use it:

  1. Down­load the WordMerger.xlsm from the link pro­vided at the top and at the bot­tom of this article.
  2. Place all the Word doc­u­ments, which you want to com­bine, into one folder (make sure all files are closed).

Word Merger -1

Word Merger –1

3. Open the WordMerger.xlsm.

Word Merger -2

Word Merger –2

4. Put the “Folder path” Exam­ple : ” C:\Users\Sumit Jain\Desktop\Word Docs“
5. Put des­ti­na­tion path for Merged Files : ” C:\Users\Sumit Jain\Desktop\“
6. Click on Fetch Files . This will fetch files from the Folder and will display.

Fetch Button

Fetch But­ton

Fetch Files

7. Select or de-select files.

Select Files

Select Files

8. Click on Merge

Merge Button

Merge But­ton

9. Files will be mer­gred and saved at the given location.

Merged File

Merged File

Com­plete Code:

    'Dim fso As New FileSystemObject

    Dim NoOfFiles As Double

    Dim counter As Integer

    Dim r_counter As Integer

    Dim s As String

    Dim listfiles As Files

    Dim newfile As Worksheet

    Dim mainworkbook As Workbook

    Dim FetchFileClicked

    Dim Folderpath As Variant
Sub Sumit()
    If FetchFileClicked = False Then
        MsgBox "First click the 'Fetch Files' button"
        End
    End If

    Application.ScreenUpdating = False
    strRandom = Replace(Replace(Replace(Now, ":", ""), "/", ""), " ", "")
    MergeFileName = "Merger" & strRandom & ".doc"
    MergeFolder = mainworkbook.Sheets("Main").Range("L10").Value

    Set objWord = CreateObject("Word.Application")

   Set objDoc = objWord.Documents.Add

   objWord.Visible = True

   Set objSelection = objWord.Selection
   objDoc.SaveAs (MergeFolder & MergeFileName)
    For i = 1 To NoOfFiles
        If Range("B" & i).Value = "Yes" Then
            Set objTempWord = CreateObject("Word.Application")
            Set tempDoc = objWord.Documents.Open(Folderpath & "\" & Range("A" & i).Value)
            Set objTempSelection = objTempWord.Selection
            tempDoc.Range.Select
            tempDoc.Range.Copy
            objSelection.TypeParagraph
            objSelection.Paste
            tempDoc.Close
        End If
    Next
    objDoc.Save
    Application.ScreenUpdating = True
    mainworkbook.Sheets("Main").Activate
    MsgBox "Completed...Merge File is saved at " & MergeFolder & MergeFileName
    FetchFileClicked = False
End Sub
Sub fetchFiles()
    Set mainworkbook = ActiveWorkbook
    Range("A:A").Clear

    Range("B:B").Clear
    Folderpath = mainworkbook.Sheets("Main").Range("L8").Value
    Set fso = CreateObject("Scripting.FileSystemObject")
    NoOfFiles = fso.GetFolder(Folderpath).Files.Count
    Set listfiles = fso.GetFolder(Folderpath).Files
    counter = 0
    For Each fls In listfiles
        counter = counter + 1
        Range("A" & counter).Value = fls.Name
        Range("B" & counter).Value = "Yes"
        Range("A" & counter).Borders.Value = 1
        Range("B" & counter).Borders.Value = 1
        With Range("B" & counter).Validation
             .Delete
            'replace "=A1:A6" with the range the data is in.
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
             Operator:=xlBetween, Formula1:="Yes,No"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    Next
     MsgBox "Files are Fetched,Please select the files to be merged"
     FetchFileClicked = True
End Sub

 

Down­load Link:Word­Merger

 

You may also like...

21 Responses

  1. Nb says:

    Hi,

    Thanks for the above code, it is really good and exactly what i am look­ing for. One thing that I seem to have a prob­lem with is to keep the source for­mat­ting and not the des­ti­na­tion for­mat­ting. Is there a method to do that easily ?

    thanks
    Nb

  2. Olav Poulsen says:

    I copied the com­plete code into a new Excel VBA Macro, to use it for merg­ing Word files cre­ated from the same Excel work book. Unfor­tu­nately the “Sumit” code will not run. I won­der if there is some­thing miss­ing or there might be an error in the code. The Macro stops claim­ing that “User-defined type not defined”. In VBA the line “Dim list­files As Files” is marked. Would be great if you can send me a unpro­tected copy of the Word­Merger file, so I can copy the code directly from your VBA code.

  3. pat says:

    I had the same for­mat­ting issue. I kept los­ing the for­mat­ting when copy­ing and past­ing. Use this in the For loop:

    objSelection.PasteAndFormat (wdPasteDefault):

  4. Hans says:

    hi Rishi, Could you please e-mail me the pass­word? I would like to make it recur­sive and fix the for­mat­ting. thank you!

  5. Rams says:

    Could you please e-mail me the pass­word? I would like to make it PDF format.

  6. kevin says:

    Does any­body know:
    Is there a com­mand to put in the macro to make the merge print each sep­a­rate doc­u­ment start­ing on a sep­a­rate page?

    The next doc­u­ment always seems to start on the very next line which often is near the bot­tom of the pre­vi­ous doc­u­ment. I just want each sub­se­quent doc­u­ment that is merged to start print­ing on the next blank page.

Leave a Reply

Your email address will not be published. Required fields are marked *

%d bloggers like this: