Home > database >  How to Iterate Copying Individual Excel Cells into Existing Word Document
How to Iterate Copying Individual Excel Cells into Existing Word Document

Time:08-31

I am trying to iterate copying information from individual cells on an Excel sheet into a Word Document so that I get them in the right order, line by line, but am having issues getting it to work and am not sure why.

Some code I've scrounged from the internet and I know it doesn't do anything (the if statement at the beginning about errnumber = 429) while the rest is what I've slapped together to get it to sort of work.

What I want to do is say "From n = 19 to x" and loop the code, but it never loops after the first pass so I have just been making each pass individually (see below) - hard to do when there's hundreds of lines. If I actually set it up as a loop, it just does the first pass and then does nothing.

In case it makes a difference, I just want to automate getting the text (and formatting, if possible) out from the Excel cells and into a Word Document, with each new cell starting on a new line and each iteration (n=n 1) starting on a new page.

Sub ARKTEST()

Dim wdapp As Object, wddoc As Object
Dim strdocname As String

On Error Resume Next
Set wdapp = GetObject(, "Word.Application")
If errnumber = 429 Then
Err.Clear
Set wdapp = CreateObject("Word.Application")
End If

wdapp.Visible = True
strdocname = "C:\Users\user.name\Documents\TESTDOC.docx"
If Dir(strdocname) = "" Then
MsgBox ("File does not exist!")
Exit Sub
End If

n = 19

wdapp.Activate
Set wddoc = wdapp.Documents(strdocname)
If wddoc Is Nothing Then Set wddoc = wdapp.Documents.Open(strdocname)
wddoc.Activate
Cells(18, 1).Copy
wddoc.Paragraphs(1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
Cells(n, 1).Copy
wddoc.Paragraphs(wddoc.BuiltinDocumentProperties(wdPropertyLines)   1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
Cells(18, 3).Copy
wddoc.Paragraphs(wddoc.BuiltinDocumentProperties(wdPropertyLines)   1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
Cells(n, 3).Copy
wddoc.Paragraphs(wddoc.BuiltinDocumentProperties(wdPropertyLines)   1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
Cells(18, 4).Copy
wddoc.Paragraphs(wddoc.BuiltinDocumentProperties(wdPropertyLines)   1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
Cells(n, 4).Copy
wddoc.Paragraphs(wddoc.BuiltinDocumentProperties(wdPropertyLines)   1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
Cells(18, 7).Copy
wddoc.Paragraphs(wddoc.BuiltinDocumentProperties(wdPropertyLines)   1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
Cells(n, 7).Copy
wddoc.Paragraphs(wddoc.BuiltinDocumentProperties(wdPropertyLines)   1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
Cells(18, 14).Copy
wddoc.Paragraphs(wddoc.BuiltinDocumentProperties(wdPropertyLines)   1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
Cells(n, 14).Copy
wddoc.Paragraphs(wddoc.BuiltinDocumentProperties(wdPropertyLines)   1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

wddoc.Paragraphs(wddoc.BuiltinDocumentProperties(wdPropertyLines)   1).Range.InsertBreak Type:=wdPageBreak
'^this only works if I change the paragraph to (1) and I don't know why.

'I do the rest of this stuff because it was on the internet, but I don't think I need it.
CutCopyMode = False

Set wddoc = Nothing
Set wdapp = Nothing
Application.CutCopyMode = False

End Sub

CodePudding user response:

The simplest approach would be to paste the lot as a table, then use the table-to-text conversion to separate cells with paragraph break separators. The pasted table would carry all of the formatting from Excel without the need for additional code.

To get the page breaks, simply insert and extra paragraph break in the last cell on each row before doing the table-to-text conversion, then use Find/Replace to replace paired paragraph breaks with page breaks.

CodePudding user response:

Thanks macropod for the response - you're probably right about that being simpler.

But to illuminate anyone else, I just discovered the issue: The only way I knew about to paste was using the Object.Paragraphs(#)... but I was counting lines instead of paragraphs.

After figuring that out, I was able to not only get the code to work, but iterate with the following correction: Changing:

wddoc.Paragraphs(wddoc.BuiltinDocumentProperties(wdPropertyLines)   1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

To look like this:

wddoc.Paragraphs(ActiveDocument.Paragraphs.Count).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
  • Related