Copy text from old table to new table

[Dave T]

Hello All,

I am upgrading quite a few Word 2003 documents to Word 2007, where the Word 2003 documents have various tables of differing widths (columns) and lengths (no. of rows).

In the Word 2007 tables I have created a new table format with specific borders and other table settings; I have also created various table styles to format the text within the tables.

My problem is how to copy the text from the old Word 2003 table and how to paste it as unformatted text (i.e. not bringing unwanted styles or formatting) into the same cells in the new Word 2007 document table?

I have played with converting the old Word 2003 table and text to tab delimited text and then removed any text formatting, but how do I get this unformatted text into the new table in the same cells as the old table.

I am aware that you can use ‘Convert Text to Table…’ but this results in a table that does not have my table formatting or styles.

Any help or suggestions would be appreciated.

Regards,
Dave T

[macropod]

Assuming both documents have the same number of tables and those tables have the same numbers of cells, you could use a macro like:

Sub Demo()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document
Dim i As Long, j As Long, Rng As Range
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
.Title = "Select the source file"
.AllowMultiSelect = False
If .Show = -1 Then
Set DocSrc = Documents.Open(.SelectedItems(1), ReadOnly:=True, AddToRecentFiles:=False)
Else
MsgBox "No source file selected. Exiting", vbExclamation
Exit Sub
End If
End With
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
.Title = "Select the target file"
.AllowMultiSelect = False
If .Show = -1 Then
Set DocTgt = Documents.Open(.SelectedItems(1), ReadOnly:=False, AddToRecentFiles:=True)
Else
MsgBox "No target file selected. Exiting", vbExclamation
DocSrc.Close SaveChanges:=False
Set DocSrc = Nothing
Exit Sub
End If
End With
With DocSrc
For i = 1 To .Tables.Count
With .Tables(i).Range
For j = 1 To .Cells.Count
Set Rng = .Cells(j).Range
With Rng
.End = .End - 1
DocTgt.Tables(i).Range.Cells(j).Range.Text = .Text
End With
Next
End With
Next
.Close SaveChanges:=False
End With
DocTgt.Activate
Set DocSrc = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
End Sub

[Dave T]

Thanks Paul,

I must admit you surprised me and until I created some dummy documents with matching tables (different text formatting) I was not sure what you had posted.
Amazing and it works well.

I had been thinking of selecting a table by clicking on the selection box at the top left of the table of the source document and then doing the same in the destination document to paste the unformatted text into that table.

If there was only one table in the source document that I wanted (i.e. that table only) to move to the destination document, how would I go about doing that.

Thanks for your help it is appreciated.

Regards,
Dave T

[macropod]

I must admit you surprised me and until I created some dummy documents with matching tables (different text formatting) I was not sure what you had posted.
Amazing and it works well.
You're not suggesting you expected something else, are you?:whip

To work with just a specified table in each document, delete the:
For i = 1 To .Tables.Count
and the corresponding:
Next
then replace the 'i' in:
With .Tables(i).Range
with the index # of the table in the source document and the 'i' in:
DocTgt.Tables(i).Range.Cells(j).Range.Text = .Text
with the index # of the table in the target document.

[Dave T]

Hello Paul,

I really do appreciate your help and no I had not expected something else.

It's just that when searching for this type of macro the only ones I could find copied the table exactly i.e. borders, formatting, everything and pasted it as a virtually identical copy into a new document, often not of my choosing.

Previously I had copied table text cell by cell and pasted it as unformatted text cell by cell into the new table, which was clumsy and time consuming.
Your macro does so much more than I expected, which is why I was blown away and tried to indicate that.
I can also see that changing the code to work on a specific table could be a pain in the _____

I really do appreciate you help.

Regards,
Dave T

[macropod]

I can also see that changing the code to work on a specific table could be a pain in the _____
You could also replace the two 'i' references with InputBoxes, so you can ask the user to indicate which source & target tables to use. For example, instead of:
With .Tables(i).Range
you might have:
With .Tables(InputBox("Which table in the source document do you want the data from?", "Source Table", 1)).Range

[snb]

To copy only the values in a table to another table that has an identical size:


Sub M_snb()
For Each cl In ActiveDocument.Tables(1).Range.Cells
ActiveDocument.Tables(2).Cell(cl.Row.Index, cl.Column.Index).Range = Replace(cl.Range, vbCr, "")
Next
End Sub

[macropod]

Once again, snb, you demonstrate your inability to pay attention. The tables are in different documents. Furthermore, your code deletes all paragraph breaks within a cell, turning the contents to mush.

[snb]

Any help or suggestions would be appreciated.

Regards,
Dave T

My post wasn't aimed at those who are not familiar with the OOP character of Word's VBA.

[macropod]

So what was it aimed at? Your use of the double negative suggests it was aimed only at those who are "familiar with the OOP character of Word's VBA", which rules out both the OP and any interest in solving his problem. In that case, why bother posting at all?

[Dave T]

Hello Paul,

Just one more quick question...

I worked my way through the different suggestions you posted.

I got it to copy a specific table number from the source document and paste it into a specific table in the destination document.
I have got the InputBox to work with the source document, but cannot work out how to specify the table number in the destination document


What do I need change in the part DocTgt.Tables(i).Range.Cells(j).Range.Text = .Text to enable a specific table to be selected?
I have tried the following DocTgt.Tables(InputBox("Which table in the destination document do you want the data copied to?", "Destination Table", 1)).Range.Cells(j).Range.Text = .Text without success.

Regards,
Dave T

[macropod]

After:
With .Tables(InputBox("Which table in the source document do you want the data from?", "Source Table", 1)).Range
you might insert:
i = InputBox("Which table in the target document do you want to add the data to?", "Target Table", 1)

[Dave T]

Hello Paul,

Hopefully just one more question...

I would like to know more about error handling.
Currently if I make a mistake i.e. copy from a table in the source document that does not have the same number of rows or columns in the destination document I get 'Run-time error has occurred: 5941'. The macro still runs but after completion the source document is still open.

How can error handling be added to what you have provided so far; i.e. the macro exits and user is advised that the destination table does not match the source table.

Regards,
Dave T

[macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document
Dim i As Long, j As Long, Rng As Range
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
.Title = "Select the source file"
.AllowMultiSelect = False
If .Show = -1 Then
Set DocSrc = Documents.Open(.SelectedItems(1), ReadOnly:=True, AddToRecentFiles:=False)
Else
MsgBox "No source file selected. Exiting", vbExclamation
Exit Sub
End If
End With
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
.Title = "Select the target file"
.AllowMultiSelect = False
If .Show = -1 Then
Set DocTgt = Documents.Open(.SelectedItems(1), ReadOnly:=False, AddToRecentFiles:=True)
Else
MsgBox "No target file selected. Exiting", vbExclamation
DocSrc.Close SaveChanges:=False
Set DocSrc = Nothing
Exit Sub
End If
End With
With DocSrc
With .Tables(InputBox("Which table in the source document do you want the data from?", "Source Table", 1)).Range
i = InputBox("Which table in the target document do you want to add the data to?", "Target Table", 1)
If .Cells.Count <> DocTgt.Tables(i).Range.Cells.Count Then
MsgBox "The Source & Target tables have different cell counts!", vbCritical, "Table Error"
DocSrc.Close SaveChanges:=False
DocTgt.Close SaveChanges:=False
GoTo ErrExit
End If
For j = 1 To .Cells.Count
Set Rng = .Cells(j).Range
With Rng
.End = .End - 1
DocTgt.Tables(i).Range.Cells(j).Range.Text = .Text
End With
Next
End With
.Close SaveChanges:=False
End With
DocTgt.Activate
ErrExit:
Set DocSrc = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
End Sub
The test as coded only checks the cell count. Checking row & column counts is problematic once one starts dealing the merged/split cells and the like.

[Dave T]

Thanks Paul,

When I tried to run this code I come up against a 'Compile error:'


With .Tables(InputBox("Which table in the source document do you want the data from?", "Source Table", 1)).Range
i = InputBox("Which table in the target document do you want to add the data to?", "Target Table", 1)


If .Cells.Count <> DocTgt.Tables(i).Cells.Count Then
MsgBox "The Source & Target tables have different cell counts!", vbCritical, "Table Error"
.Close SaveChanges:=False
DocTgt.Close SaveChanges:=False
GoTo ErrExit
End If


Regards,
Dave T

[macropod]

Try the updated code.

[Dave T]

Hello Paul,

I really do appreciate all you have done and for the updated code.
Sorry if my error handling comment caused you extra work.

Regards,
David

[macropod]

No worries!