Copying Rows from One Doc to Another

[Sonny Maou]

I've got many pages of tables, which contain certain rows that I need
copied to a new document. I've got this far but can't get beyond getting
the rows "pasted" into the new doc. Can somebody point me straight?!
Thanks!

oDoc = ActiveDocument.Name
Documents.Add
pDoc = ActiveDocument.Name

For Each tbl In Documents(oDoc).Tables
For r = 10 To 20 'the rows I need from each table!
If r <> 13 And r <> 17 Then ' but skip these rows
hasData = False
nRow = ""
For c = 1 To 12
v = tbl.Cell(r, c).Range.Text
If Asc(v) <> 13 Then
hasData = True 'don't copy if devoid of text
End If
Next
If hasData Then 'idiot code below... need help!
tbl.Rows(r).Range.Select
Selection.Copy
Documents(pDoc).Range.Paste
End If
End If
Next
Next

 

[Jezebel]

What's not clear from this is what you want to end up with: the actual rows,
or merely the cell contents? As it is, you're pasting the cell *contents*
into the target document, but as plain text rather than table rows. Is that
what you want?

 

[Sonny Maou]

What's not clear from this is what you want to end up with: the actual rows,
or merely the cell contents? As it is, you're pasting the cell *contents*
into the target document, but as plain text rather than table rows. Is that
what you want?

No. I want the actual rows so that it builds a new table in the new doc.

 

[Jezebel]

In that case, I think it would be simpler to make a copy of the original
document and delete all the stuff you don't want --

1. Delete all paragraphs not in a table, but leaving a single empty
paragraph so the tables don't get joined.

2. For each table, delete all the rows you don't want (working backwards to
make the ariithemetic easier) --

For each pTbl in ActiveDocument.Tables
For r = pTbl.Rows.Count to 1 step -1
If r > 20 or r = 17 or r = 13 or r < 10
pTbl.Rows(r).Delete
Next
Next

 

[Helmut Weber]

Hi Sonny,
as Jezebel indicated,
the problem is more the question as the answer.

May I add my own decent bit, with improvements possible, I think:

Sub Makro2()
Dim rtmp As Range
Dim doc1 As Document
Dim doc2 As Document
Dim rtmp1 As Range
Dim l As Long
Dim t As Long
' having saved the source.doc under another name
Set doc1 = Documents("copysource.doc")
Set doc2 = Documents("target.doc")
t = doc1.Tables.Count
For l = 1 To t
doc1.Activate
' delete anyway
doc1.Tables(l).Rows(17).Delete
doc1.Tables(l).Rows(13).Delete
' delete rows containing empty cells ???
' after that copy whole tables !
doc1.Tables(l).Select
Selection.Copy
Set rtmp = doc2.Range
rtmp.Start = doc2.Range.End
rtmp.Paste
Next
End Sub

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Sonny Maou]

In that case, I think it would be simpler to make a copy of the original
document and delete all the stuff you don't want --

Hey, thanks Jezebel. Interesting approach.

 

[Sonny Maou]

In that case, I think it would be simpler to make a copy of the original
document...

Okay, so how do I copy a document?

I tried...

oDoc = ActiveDocument.Name
Documents.Add
pDoc = ActiveDocument.Name
Documents(pDoc).Range = Documents(oDoc).Range

....but that's just copying the text!

 

[Jonathan West]

Okay, so how do I copy a document?

I tried...

oDoc = ActiveDocument.Name
Documents.Add
pDoc = ActiveDocument.Name
Documents(pDoc).Range = Documents(oDoc).Range

...but that's just copying the text!

You can close the document and then use FileCopy to copy the file. Or you
can copy the formatted text to a new document using this line of code

Documents.Add.Content.FormattedText = ActiveDocument.Content

 

[Jezebel]

SaveAs

Okay, so how do I copy a document?

I tried...

oDoc = ActiveDocument.Name
Documents.Add
pDoc = ActiveDocument.Name
Documents(pDoc).Range = Documents(oDoc).Range

...but that's just copying the text!