Copy Table using Range Object

ArchieDog · May 1st, 2009, 01:12 PM

Hi All

I am using the Range object to copy the contents of one document to a new one. I have tried pasting and also just making the range of the new document equal that of the source document. However, I cannot get it to retain tables in the new document, even if I use FormattedText. Is there a way to copy tables over? Is it also possible to retain their formatting?

Many thanks for any help
Archie

Shasur · May 1st, 2009, 09:47 PM

Can you try something like the following:

Sub CopyContentsWithTable_Across_Documents()
Dim oWD1 As Word.Document
Dim oWD2 As Word.Document
Dim oRange As Word.Range
Set oWD1 = ActiveDocument
Set oWD2 = Documents.Open("C:\Documents\Sample.docx")
Set oRange = oWD2.Range(oWD2.Paragraphs(50).Range.Start, oWD2.Paragraphs(62).Range.End)
oRange.Copy
oWD1.Paragraphs(1).Range.Select
Selection.Paste

End Sub

Cheers
Shasur

ArchieDog · May 2nd, 2009, 07:10 AM

Thank you very much for your reply, Shasur.

The code you posted does work thank you. I amended it slightly as follows to work with the entire document:

Code:

Set oRange = oWD2.Range(oWD2.Paragraphs(1).Range.Start, oWD2.Paragraphs(oWD2.Paragraphs.Count).Range.End)

I am embarassed

to say though that the code I thought was not working yesterday is doing so today. I have included it here in case it is of any use to anyone in the future:

Code:

Sub CopyDocContent()
'copy entire document
Dim dSource As Document, dTarget As Document
Dim rSource As Range, rTarget As Range

Set dSource = ActiveDocument
Set rSource = dSource.Range
Set dTarget = Documents.Add
Set rTarget = dTarget.Range
rTarget.FormattedText = rSource.FormattedText
Set dSource = Nothing
Set rSource = Nothing
Set dTarget = Nothing
Set rTarget = Nothing
End Sub
 
Sub CopyDocContent2()
Dim dSource As Document, dTarget As Document
Dim rSource As Range, rTarget As Range
Set dSource = ActiveDocument
Set rSource = dSource.Range
'do not copy the last carriage return
With rSource
    .End = .End - 1
    .Copy
End With
Set dTarget = Documents.Add
Set rTarget = dTarget.Range
rTarget.Paste
Set dSource = Nothing
Set rSource = Nothing
Set dTarget = Nothing
Set rTarget = Nothing
End Sub

Thank you for taking the time to respond.

Archie