Copying markups from one table to another

C

Chilly

I have a document that has one table containing markups. I need to copy the
cell contents (including markups) into another table. How do I do it? The
methods for copying markups in non-table text do not seem to work. Any help
is appreciated.
 
K

Klaus Linke

Hi Chilly,

Nothing built-in allows you to copy and paste table cells including their
formatting, AFAIK.

You can try the macros below.

"CopyTableCells" just puts a bookmark "oldCells" on selected cells.
"PasteTableCells" then pastes the cells from that bookmark into the selected
cells, and formats them.

The macro isn't exceedingly clever, and doesn't try to catch errors (say if
you aren't in a table when running them, or when you selected more or less
cells when pasting than when "copying".)

If you haven't used macros before, see
http://www.word.mvps.org/FAQs/MacrosVBA/CreateAMacro.htm

Regards,
Klaus


Sub CopyTableCells()
ActiveDocument.Bookmarks.Add _
Range:=Selection.Range, _
Name:="oldCells"
End Sub

Sub PasteTableCells()
Dim myCell As Cell
Dim oldCell As Cell
Dim myShading As Shading
Dim i As Long
ActiveDocument.Bookmarks.Add _
Range:=Selection.Range, _
Name:="newCells"
' Copy/paste over the contents
ActiveDocument.Bookmarks("oldCells").Select
Selection.Copy
ActiveDocument.Bookmarks("newCells").Select
Selection.Paste

' Format the cells like those in bookmark "oldCells":
With ActiveDocument.Bookmarks("oldCells").Range.Cells
For i = 1 To Selection.Cells.Count
ActiveDocument.Bookmarks("oldCells").Select
If Selection.Cells.Count >= i Then
Set oldCell = Selection.Cells(i)
Else
Set oldCell = Selection.Cells(1)
End If
ActiveDocument.Bookmarks("newCells").Select
Set myCell = Selection.Cells(i)
With myCell
With .Shading
.BackgroundPatternColorIndex = _
oldCell.Shading.BackgroundPatternColorIndex
.BackgroundPatternColor = _
oldCell.Shading.BackgroundPatternColor
.ForegroundPatternColorIndex = _
oldCell.Shading.ForegroundPatternColorIndex
.ForegroundPatternColor = _
oldCell.Shading.ForegroundPatternColor
.Texture = oldCell.Shading.Texture
End With
.Borders = oldCell.Borders
.LeftPadding = oldCell.LeftPadding
.RightPadding = oldCell.RightPadding
.TopPadding = oldCell.TopPadding
.BottomPadding = oldCell.BottomPadding
.HeightRule = oldCell.HeightRule
If oldCell.Height <> wdUndefined Then
.Height = oldCell.Height
End If
.Column.PreferredWidthType = _
oldCell.PreferredWidthType
.Column.PreferredWidth = _
oldCell.PreferredWidth
.Column.Width = oldCell.Width
End With
Next i
End With
ActiveDocument.Bookmarks("newCells").Select
End Sub
 
C

Chilly

Thanks. I'll give it a try.

Klaus Linke said:
Hi Chilly,

Nothing built-in allows you to copy and paste table cells including their
formatting, AFAIK.

You can try the macros below.

"CopyTableCells" just puts a bookmark "oldCells" on selected cells.
"PasteTableCells" then pastes the cells from that bookmark into the selected
cells, and formats them.

The macro isn't exceedingly clever, and doesn't try to catch errors (say if
you aren't in a table when running them, or when you selected more or less
cells when pasting than when "copying".)

If you haven't used macros before, see
http://www.word.mvps.org/FAQs/MacrosVBA/CreateAMacro.htm

Regards,
Klaus


Sub CopyTableCells()
ActiveDocument.Bookmarks.Add _
Range:=Selection.Range, _
Name:="oldCells"
End Sub

Sub PasteTableCells()
Dim myCell As Cell
Dim oldCell As Cell
Dim myShading As Shading
Dim i As Long
ActiveDocument.Bookmarks.Add _
Range:=Selection.Range, _
Name:="newCells"
' Copy/paste over the contents
ActiveDocument.Bookmarks("oldCells").Select
Selection.Copy
ActiveDocument.Bookmarks("newCells").Select
Selection.Paste

' Format the cells like those in bookmark "oldCells":
With ActiveDocument.Bookmarks("oldCells").Range.Cells
For i = 1 To Selection.Cells.Count
ActiveDocument.Bookmarks("oldCells").Select
If Selection.Cells.Count >= i Then
Set oldCell = Selection.Cells(i)
Else
Set oldCell = Selection.Cells(1)
End If
ActiveDocument.Bookmarks("newCells").Select
Set myCell = Selection.Cells(i)
With myCell
With .Shading
.BackgroundPatternColorIndex = _
oldCell.Shading.BackgroundPatternColorIndex
.BackgroundPatternColor = _
oldCell.Shading.BackgroundPatternColor
.ForegroundPatternColorIndex = _
oldCell.Shading.ForegroundPatternColorIndex
.ForegroundPatternColor = _
oldCell.Shading.ForegroundPatternColor
.Texture = oldCell.Shading.Texture
End With
.Borders = oldCell.Borders
.LeftPadding = oldCell.LeftPadding
.RightPadding = oldCell.RightPadding
.TopPadding = oldCell.TopPadding
.BottomPadding = oldCell.BottomPadding
.HeightRule = oldCell.HeightRule
If oldCell.Height <> wdUndefined Then
.Height = oldCell.Height
End If
.Column.PreferredWidthType = _
oldCell.PreferredWidthType
.Column.PreferredWidth = _
oldCell.PreferredWidth
.Column.Width = oldCell.Width
End With
Next i
End With
ActiveDocument.Bookmarks("newCells").Select
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top