2x Worksheet to Word

[beczer]

Hi there

I need your help.

Below Macro exports data (cells) from external Worksheet into Word template (bookmarks)

Problem: I would like to add a possibility to export data (cells) from current active Worksheet (opened, where there is a macro) into the same Word Template.

Is it works fine but as I said I need to export data from two Worksheets (external and active with Macro) into one Word template.

Option ExplicitSub SomeSub()
    Dim r As Integer
    Dim wdApp As Word.Application
    Dim doc As Word.Document
    Dim wkbCRMExt As Workbook
    Dim wksCRMExt As Worksheet
    Set wkbCRMExt = Workbooks.Open(Environ("UserProfile") & "\Desktop\CRM.xlsx")
    Set wksCRMExt = wkbCRMExt.Sheets(1)
    
    wksCRM.Range("B1:B5").Value = wksCRMExt.Range("B1:B5").Value
    
    wkbCRMExt.Close False
    
    Set wdApp = New Word.Application
    Set doc = wdApp.Documents.Open(Environ("UserProfile") & "\" & Sheets("Path").Cells(1))
   
    For r = 1 To 5
        doc.Bookmarks(wksCRM.Cells(r, 1).Value).Range.Text = wksCRM.Cells(r, 2).Value
        
      
         Set wdApp = New Word.Application
    Set doc = wdApp.Documents.Open(Environ("UserProfile") & "\" & Sheets("Path").Cells(1))


   
    Next
    
    doc.SaveAs2 Environ$("UserProfile") & "\Desktop\Doc1.docx"
    doc.Close False
    
End Sub

Thanks in advance

Tom