how to copy unique data in their related word path using vba-CodePudding

Dears,

I want to copy a cell to its related word doc. I have all word paths and their related text in the cell next to it, which needs to be copied to its related word doc. I wrote a code that copies a cell to the open docs tabl, but I want it to be automated and open the first path and copy the related cell to that. can anyone help me on this?

Sub copy()

Dim rng As Range
Dim v As Variant
Dim col As Long, r As Long
Dim wordApp As Word.Application
    

Set rng = ThisWorkbook.Worksheets("Sheet1").Range("B2")

col = 1 'start with this column

r = 2 ' row

For Each v In rng.Cells
    ActiveDocument.Tables(13).Cell(r, col).Range.Text = v.Value
    col = col   1

Next v

End Sub

```

CodePudding user response：

ActiveDocument is an element of a sample of wordApp
So, seems to be

 wordApp.ActiveDocument.Tables(13).Cell(r, col).Range.Text = v.Value

Or the problem is that it need to add columns in Tables(13)?

CodePudding user response：

The problem is that you haven't got any wordApp object You declare the variable as application, but don't use it. See code below:

Sub copy() 


Dim rng As Range
Dim v As Variant
Dim col As Long, r As Long
Dim wApp As Object' create an object for application object
Dim wDoc As New Word.Document' set object for Word document
Set wApp = CreateObject("Word.Application")' creates a sample of application object
wApp.Visible = True ' you can swith it to False if you don't need to see application

Set rng = ThisWorkbook.Worksheets("Sheet1").Range("B2")

col = 1 'start with this column

r = 2 ' row

wApp.Documents.Open Filename:="Filename" ' "Filename"= name of your word file. Here you open it. 
Set wDoc = GetObject("Filename")' here you link your word document to word document object: after this you have two samples of objects - application object and document object 

For Each v In rng.Cells
wApp.wDoc.Tables(13).Cell(r, col).Range.Text = v.Value
col = col   1

Next v

End Sub

CodePudding user response：

Try this - make sure that your rng range is not empty

Dim rng As Range
Dim v As Variant
Dim col As Long, r As Long
Dim wApp As Object
Set wApp = CreateObject("Word.Application")
wApp.Visible = True ' you can swith it to False
Dim wDoc As New Word.Document
Set rng = ActiveWorkbook.Worksheets("Sheet1").Range("B2")

col = 1 'start with this column

r = 2 ' row

wApp.Documents.Open Filename:="C:\Users\shevti\Downloads\1.docx" ' your word file
Set wDoc = GetObject("C:\Users\shevti\Downloads\1.docx")

For Each v In rng.Cells


wDoc.Tables(13).Cell(r, col).Range.Text = v.Value
col = col   1

Next v

End Sub