word dosyalarını birleştirme

[Z3U519]

Arkadaşlar elimde 81 il için ayrı ayrı bilgiler içeren kartlar var ben bu kartları exceldeki gibi yeni sekme ekleyerek tek dosyada birleştirmek istiyorum ancak dediğim gibi sekmede olacak yani bilgiler alt alta gelmeyecek ayrı ayrı sayfalarda olacak böyle bir şey mümkün mü? Eğer böyle bir şansım yoksa bu 81 ili tek seferde yazdıramıyorum tek dosya olmadığı için bunun bir çözümü var mı yani tek seferde yazdırabilir miyim?

 

[Teoman06]

Insert >> Object > Text From File

menüsü ile seçtiğiniz tüm dokümanlardaki metinleri alt alta yeni bir dokümanda toplayabilirsiniz. Aralarına da page braeak koyarsanız, bu iş olur.

Burada da makrolu çözüm var;

http://www.extendoffice.com/documents/word/969-word-merge-multiple-documents.html

 

[Z3U519]

Teşekkürler cevap için ama dediğini şekilde yapınca sayfa yapıları çok bozuluyor.

 

[mancubus]

excel üzerinden çalıştırılarak word dosyalarını tek bir dosya haline getiren kod. ilgili forumda soruyu soran aynı problemden bahsetmiş ve bu cevap üzerine sorunun çözüldüğünü söylemiş.

ben test etmedim açıkçası.

kendi durumunuza uyarlayın.

Sub MergeDocs1() 
     'ZVI:2013-10-08 http://www.vbaexpress.com/forum/showthread.php?47741-Word-macro-need-to-run-it-from-excel
    Const wdCollapseEnd As Long = 0, wdPageBreak As Long = 7 
    Dim objWord As Object, strFile As String, strFile1 As String, strFolder As String 
     
     ' If this workbook is saved in the same folder as the DOCs then use this line:
    strFolder = ThisWorkbook.Path & "\" 
     ' Else uncomment the line below and change it appropriately
     'strFolder = "d:\aagon\data\Poi\Dropbox\Family\Miki\Envelope_to_send\"
     
     ' Get/Create Word Application object
    On Error Resume Next 
    Set objWord = GetObject(, "Word.Application") 
    If Err <> 0 Then Set objWord = CreateObject("Word.Application") 
     
     ' Trap errors
    On Error Goto exit_ 
     
     ' Find name of the 1st document and save it
    strFile = Dir$(strFolder & "*.doc*") 
    strFile1 = strFile 
     
     ' Merge documents
    If Len(strFile) Then 
        With objWord.Documents.Open(strFolder & strFile, , True).Range 
            While Len(strFile) 
                If strFile <> strFile1 Then 
                    With .Characters.Last 
                        .Collapse wdCollapseEnd 
                        .InsertBreak wdPageBreak 
                        .InsertFile strFolder & strFile 
                    End With 
                End If 
                strFile = Dir$ 
            Wend 
        End With 
    End If 
     
exit_: 
     
    objWord.Visible = True 
    If Err Then MsgBox strFile & vbLf & Err.Description, vbCritical, "Error #" & Err.Number 
     
End Sub