• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 252
  • Last Modified:

Is it possible to use a macro to copy info from an excel doc to a word doc?

I have an excel workbook (see image) and a word document. The word document needs information in it that are in specific cells of the excel workbook. Is it possible to have a macro do this? If the document needs to be in the excel workbook that is fine.

It would need to do this several times, once for each group of data. In the image the first group of data would be T6:T7, Y8, and AG8. The second group of data would be T10:T16, Y17, and AG17.

I have a macro that converts a sheet to a pdf so after copying each group of data to the word doc or sheet it will need to run my pdf macro and then clear the copied data to prepare for the next group of data.

I hope this isn't asking too much.

Capture.JPG
0
varesources
Asked:
varesources
  • 4
  • 3
1 Solution
 
varesourcesAuthor Commented:
I found the following through Bing but I'm not sure if it is a good starting place.
Sub AutoFillWordTables()

  Dim C As Long
  Dim FileFilter As String
  Dim LastCol As Long
  Dim R As Long
  Dim Rng As Excel.Range
  Dim WordFile As String
  Dim wdApp As Object
  Dim wdDoc As Object
  Dim wdTbl As Object
  Dim Wks As Worksheet
  
    Set Wks = Worksheets("Sheet1")
    Set Rng = Wks.Range("A1:A6")
    
    LastCol = Wks.Cells(Rng.Row, Columns.Count).End(xlToLeft).Column
    Set Rng = Rng.Resize(ColumnSize:=LastCol)
    
      FileFilter = "Word Documents(*.doc),*.doc, All Files(*.*),*.*"
      WordFile = Excel.Application.GetOpenFilename(FileFilter)
    
      If WordFile = "False" Then Exit Sub
    
        Set wdApp = CreateObject("Word.Application")
        Set wdDoc = wdApp.Documents.Open(WordFile)
        
        For C = 1 To LastCol
          Set wdTbl = wdDoc.Tables(C)
            For R = 1 To Rng.Rows.Count
              wdTbl.Range.Cells(R).Range.Text = Rng.Cells(R, C)
            Next R
        Next C
        
       wdApp.Visible = True
    
    Set wdApp = Nothing
    Set wdDoc = Nothing
    Set wdTbl = Nothing

Open in new window

0
 
varesourcesAuthor Commented:
Anyone?
0
 
Saqib Husain, SyedEngineerCommented:
Why don't you upload a sample file? It would be easier for me to work on a file instead of trying to build one then work on it.

Saqib
0
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

 
varesourcesAuthor Commented:
Here is an example of the data and the word document.
EEData.xlsm
EEDoc.docx
0
 
varesourcesAuthor Commented:
I think that these might be the steps needed.

1. Copy group of information from Sheet1 to Sheet2
2. Word document auto updates info because the cells are linked to the Word doc.
3. Save as PDF macro in Word is run.
4. Sheet2 info is cleared.
5. Start over.
0
 
Saqib Husain, SyedEngineerCommented:
Hello, I am sorry I had lost track of this question. Do you still want to continue with it?
0
 
Saqib Husain, SyedEngineerCommented:
Ok I have come up with a code.For this I have modified the template file to tell it where to find the numbers from.

 EEDoc.docx

Paste this code in a new module in excel and run it using the given sample excel file.
Sub post2word()
Set wrd = GetObject(, "Word.application")
Set doc = wrd.activedocument
Set wt = doc.Range(0, doc.Characters.Count)
wtv = wt
adl = InStr(wtv, "[[")
Do While adl <> 0
ads = ads & Mid(wtv, adl, InStr(adl, wtv, "]]") + 2 - adl) & ","
adl = InStr(adl + 1, wtv, "[[")
Loop
ads = Split(Left(ads, Len(ads) - 1), ",")
Set blkstart = Range("A6")
Do While blkstart.Value <> ""
    If blkstart.Offset(1, 0) = "" Then
    Set blkend = blkstart
    Else
    Set blkend = blkstart.End(xlDown)
    End If
    ptxt = wtv
    For Each ad In ads
    rt = Range(Mid(ad, 3, Len(ad) - 4) & blkend.Row + 1).Text
    ptxt = Replace(ptxt, ad, rt, , 1)
    Next ad
    For p = blkstart.Row To blkend.Row
    ptxt = ptxt & Cells(p, "T") & vbCrLf
    Next p
    ptxt = ptxt & vbCrLf & vbCrLf
    doc.Range(doc.Characters.Count - 1).insertafter ptxt
    Set blkstart = blkend.Offset(3, 1)
Loop
End Sub

Open in new window

0
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now