VBA xuất Excel sang Word

[Chian91]

Hiện tại e có File xuất Excel sang Word. Nhưng mỗi lần xuất sang Word là xuất sang 1 file mới. Nhờ các Bác chỉnh giúp em để tất cả các lần xuất đều nằm trên 1 file Word. Em cám ơn ạ!

 

[batman1]

Thử kiểm tra kỹ code sau.
Lần chạy đầu codesẽ tạo tập tin "doc1.docx" trong cùng thư mục với tập tin Excel. Tên và vị trí của tập tin DOCX tự thay đổi cho phù hợp.

Sub Export_to_Word()
Const wdCollapseEnd = 0

Dim wdapp As Object, wddoc As Object
Dim newdoc As Boolean
    On Error Resume Next
    Sheet1.Range("A1:H20").Copy
    Set wdapp = GetObject(, "word.Application")
    If Err.Number Then
        Err.Clear
        Set wdapp = CreateObject("Word.Application")
    End If
    wdapp.Visible = True
    Set wddoc = wdapp.documents("doc1.docx")
    If Err.Number Then
        Err.Clear
        Set wddoc = wdapp.documents.Open(ThisWorkbook.Path & "\doc1.docx")
        If Err.Number Then
            Err.Clear
            Set wddoc = wdapp.documents.Add
            wddoc.SaveAs2 ThisWorkbook.Path & "\doc1.docx"
            newdoc = True
        End If
    End If
    wddoc.Active
    If Not newdoc Then
        wddoc.Content.Select
        With wdapp.Selection
            .Collapse wdCollapseEnd
            .InsertNewPage
        End With
    End If
    wdapp.Selection.PasteSpecial xlPasteValues
    Set wddoc = Nothing
    Set wdapp = Nothing
    Application.CutCopyMode = False
    
    MsgBox "Done!"
End Sub

 

[batman1]

Tôi quên
Sửa

wdapp.Selection.PasteSpecial xlPasteValues

thành

wdapp.Selection.PasteSpecial

 

[lenolim]

Thử kiểm tra kỹ code sau.
Lần chạy đầu codesẽ tạo tập tin "doc1.docx" trong cùng thư mục với tập tin Excel. Tên và vị trí của tập tin DOCX tự thay đổi cho phù hợp.

Sub Export_to_Word()
Const wdCollapseEnd = 0

Dim wdapp As Object, wddoc As Object
Dim newdoc As Boolean
    On Error Resume Next
    Sheet1.Range("A1:H20").Copy
    Set wdapp = GetObject(, "word.Application")
    If Err.Number Then
        Err.Clear
        Set wdapp = CreateObject("Word.Application")
    End If
    wdapp.Visible = True
    Set wddoc = wdapp.documents("doc1.docx")
    If Err.Number Then
        Err.Clear
        Set wddoc = wdapp.documents.Open(ThisWorkbook.Path & "\doc1.docx")
        If Err.Number Then
            Err.Clear
            Set wddoc = wdapp.documents.Add
            wddoc.SaveAs2 ThisWorkbook.Path & "\doc1.docx"
            newdoc = True
        End If
    End If
    wddoc.Active
    If Not newdoc Then
        wddoc.Content.Select
        With wdapp.Selection
            .Collapse wdCollapseEnd
            .InsertNewPage
        End With
    End If
    wdapp.Selection.PasteSpecial xlPasteValues
    Set wddoc = Nothing
    Set wdapp = Nothing
    Application.CutCopyMode = False
   
    MsgBox "Done!"
End Sub

- Xin phép được chen ngang chủ đề của chủ thớt.
- Mình thấy chủ đề này cũng gần đúng với yêu cầu của mình. Nên đã tạo một chủ đề mới, xin được nhờ các thành viên giúp đỡ.
- Nay! Xin được nhờ thành viên batman1, xem và trợ giúp theo link: www.giaiphapexcel.com/diendan/threads/sửa-lại-code-chuyển-dữ-liệu-từ-excel-sang-word.145571/#post-941351
Xin được cảm ơn trước !