Copying cells containing line feeds from Word to Excel

[Guillermo]

[Context: automating Excel from within Word]

Hello,

I want to copy a single column table from Word to a spreadsheet. I know that due to an
Excel feature (bug?), copied cells from a Word table are pasted in separate cells in
Excel if they contain line feeds. Doing it by hand, you can get around this by
doubleclicking on the spreadsheet before actually pasting the Word cell's content -
one by one.

Using the following code...

...

Sub DOCTable2XLS()

Dim appXLS As Excel.Application
Dim a As Integer
Dim b As Long
Dim c As Cell

Set appXLS = GetObject(, "Excel.Application")
a = appXLS.ActiveCell.Column
b = appXLS.ActiveCell.Row

'appXLS.Visible = True
For Each c In ActiveDocument.Tables(1).Columns(1).Cells

c.Select
Selection.Copy
appXLS.ActiveCell.PasteSpecial xlPasteValues
b = b + 1
appXLS.Cells(b, a).Activate

Next

End Sub

...

... I do get the Word table copied to Excel, but only the first line of each Word cell.

I'd like to know if there's a method to tell Excel to "enter" (like you do when
pressing F2 or doubleclicking) each cell for editing before copying the Word cell
contents. Alternatively, I could replace each line feed in Word with a placeholder
like "~r~" and then replace it again in Excel with a manual line feed, but I don't
know how to do that in Excel either.

[Shauna Kelly]

Hi Guillermo

You can use code something like the following. This only works for text in
the Word table; it won't copy things like pictures. In any case, you'll need
to add appropriate error checking.

Sub DOCTable2XLS()

Dim appXLS As Excel.Application
Dim wdCell As Word.Cell
Dim xlCell As Excel.Range
Dim sText As String

Set appXLS = GetObject(, "Excel.Application")

'Get a reference to the active cell in Excel
Set xlCell = appXLS.ActiveCell

For Each wdCell In ActiveDocument.Tables(1).Columns(1).Cells

'Get the text of the Word cell
sText = wdCell.Range.Text

'Strip out the end-of-cell markers
sText = Left(sText, Len(sText) - 2)

'Replace end-of-paragraph markers with vbLfs so that
'cells with more than one paragrah work in Excel
sText = Replace(sText, Chr(13), vbLf)

'Set the value of the Excel cell to the text
'in the Word cell
xlCell.Value = sText

'Get a reference to the next Excel cell
Set xlCell = xlCell.Offset(1, 0)

Next wdCell

End Sub

Hope this helps.

Shauna Kelly. Microsoft MVP.
http://www.shaunakelly.com/word

"Guillermo" <guil...@deletethislopez-anglada.com> wrote in message
news:ORn4qecU...@TK2MSFTNGP11.phx.gbl...

[Guillermo]

Hi Shauna,

Brilliant! Exactly what I wanted to know.

Thanks,

Guillermo

[Shauna Kelly]

Hi Guillermo

I'm glad to hear it worked.

Shauna

Shauna Kelly. Microsoft MVP.
http://www.shaunakelly.com/word

"Guillermo" <guil...@deletethislopez-anglada.com> wrote in message

news:utr$lfrUGH...@TK2MSFTNGP14.phx.gbl...