Copying named ranges in Excel to Word document

[mikeymay]

I am using the following code which works when copying named ranges in Excel that consist of only 1 cell

For Each xlName In wb.Names
     If docWord.Bookmarks.Exists(xlName.Name) Then
        docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Name).Value
        Else
    End If
Next xlName

Is there a way of doing this but when each range can potentially consist of more than 1 cell.

Also, when dropping into the Word document I woudl like it to show as columnar as it appears in the Excel workbook.


Thanks

 

[chiello]

Hi MikeyMay,
the following code copies to WORD single cell ranges as simple text, while copies as tables multiple cell ranges. It also restores bookmarks, so that next time they will be still available.

Dim StartRange As Long
For Each xlName In wb.Names
     If docWord.Bookmarks.Exists(xlName.Name) Then
        StartRange = docWord.Bookmarks(xlName.Name).Range.Start
        If docWord.Bookmarks(xlName.Name).Range.Tables.Count Then
            docWord.Bookmarks(xlName.Name).Range.Cells.Delete
        Else
            docWord.Bookmarks(xlName.Name).Range.Delete
        End If
        If Range(xlName.Name).Cells.Count = 1 Then
            docWord.Range(StartRange, StartRange).InsertAfter Range(xlName.Name).Value
            docWord.Bookmarks.Add xlName.Name, docWord.Range(StartRange, _
                StartRange + Len(Range(xlName.Name).Value))
        Else
            Range(xlName.Name).Copy
            Stop
            docWord.Range(StartRange, StartRange).Paste
            docWord.Bookmarks.Add xlName.Name, docWord.Range(StartRange, StartRange).Tables(1)
        End If
     End If
Next xlName

Post for feedback

Ciao

Andrea

 

[mikeymay]

Thx for the code!

It seems to work apart from

docWord.Bookmarks.Add xlName.Name, docWord.Range(StartRange, StartRange).Tables(1)

Falls down here with run-time error 'The requested memeber of the collection does not exist'

Can't quite figure out what this line is doing as the data has been pasted to the word document and don't have any other tables.

Just 2 issues -

1 - When pasted into Word I would like it to just paste in as text rather than an 'object', ie without cells borders showing (can it be pasted with 'Paste Special', 'Unformatted Text'?)

2 - If the number of transactions goes beyond 1 page can I set up headers, ie Invoice Date, Invoice Number and Invoice Amount?

Other than that, a great bit of code

Many thanks

 

[chiello]

Try this code:

Dim StartRange As Long, EndRange As Long


For Each xlName In wb.Names
     If docWord.Bookmarks.Exists(xlName.Name) Then
        StartRange = docWord.Bookmarks(xlName.Name).Range.Start
        EndRange = docWord.Bookmarks(xlName.Name).Range.End + 1
        docWord.Bookmarks(xlName.Name).Range.Delete
        Range(xlName.Name).Copy
        docWord.Range(StartRange, StartRange).PasteSpecial Link:=False, _
            DataType:=wdPasteText, Placement:=wdInLine, DisplayAsIcon:=False
        docWord.Bookmarks.Add xlName.Name, docWord.Range(StartRange, EndRange - 1)
     End If
Next xlName

2 - If the number of transactions goes beyond 1 page can I set up headers, ie Invoice Date, Invoice Number and Invoice Amount?

Sorry but I'm afraid I do not understand. Please, try to explain further.

Ciao

Andrea

 

[mikeymay]

A word document will be, for example, 60 lines long per page. The template document I am using will have headers - Date, Invoice Number, amount, etc on page 1. If the number of cells being copied from Excel is 60+ how do I tell word to add the headers to page 2 of the document?


Thanks

 

[mikeymay]

Also tried the code above and the problem I now have is when the Excel range is copied to the bookmark in Word it is not copying in table form, ie columnar. If the bookmark is starts 40 space to the right of the document the first cell copied drops in at the bookmark but the remainder drop in to the far left of the documnet as if the carraige return has been hit and is no longer in columnar form.

Could this code be used to enter the copied ranges into a table?

 

[chiello]

A word document will be, for example, 60 lines long per page. The template document I am using will have headers - Date, Invoice Number, amount, etc on page 1. If the number of cells being copied from Excel is 60+ how do I tell word to add the headers to page 2 of the document?

Also tried the code above and the problem I now have is when the Excel range is copied to the bookmark in Word it is not copying in table form, ie columnar. If the bookmark is starts 40 space to the right of the document the first cell copied drops in at the bookmark but the remainder drop in to the far left of the documnet as if the carraige return has been hit and is no longer in columnar form.

Range consisting of more than 1 cell
I think the best solution is using table bookmarks (insert table, fill first row with headers, and leave at least an other row for data. Then select the table and add the bookmark).
Remember to set the option "Repeat first row as header"
Furthermore, remove spaces and increase left indent, so the table will be placed toward the right side of the page

1 cell range
Use simple bookmark (the ones you have already)

Use the code below:

Dim StartRange As Long, iROW As Long
Dim xlsNr As Single, docNr As Single, docNc As Single
Dim iTABLE As Word.Table

For Each xlName In wb.Names
     If docWord.Bookmarks.Exists(xlName.Name) Then
        If Range(xlName.Name).Cells.Count = 1 Then
            StartRange = docWord.Bookmarks(xlName.Name).Range.Start
            docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Name).Value
            docWord.Bookmarks.Add xlName.Name, docWord.Range(StartRange, _
                StartRange + Len(Range(xlName.Name).Value))
        Else
            With Range(xlName.Name)
                .Copy
                xlsNr = .Rows.Count
            End With
            Set iTABLE = docWord.Bookmarks(xlName.Name).Range.Tables(1)
            docNr = iTABLE.Rows.Count
            docNc = iTABLE.Columns.Count
            If docNr > xlsNr + 1 Then
                For iROW = 1 To docNr - xlsNr - 1
                    iTABLE.Rows(2).Delete
                Next iROW
            ElseIf docNr < xlsNr Then
                For iROW = 1 To xlsNr - docNr + 1
                    iTABLE.Rows.Add BeforeRow:=iTABLE.Rows(2)
                Next iROW
            End If
            docNr = iTABLE.Rows.Count
            docWord.Range(iTABLE.Cell(2, 1).Range.Start, _
                iTABLE.Cell(docNr, docNc).Range.End).PasteSpecial _
                Link:=False, DataType:=wdPasteText, Placement:=wdInLine, _
                DisplayAsIcon:=False
            Application.CutCopyMode = False
        End If
     End If
Next xlName

Ciao

Andrea