CODEWITHSUNDEEP
vbaexcelms-word
Bhargavi N
Bhargavi N

Reputation: 3

To copy text from excel to word as sentence without cell borders

I have an excel with a specific column having text in multiple lines within each cells. I want to copy that multi-line text into word document as sentence in word format. I tried several codes but all that copies the excel range and pastes in word exactly the same way it is in excel including the cell borders. I do not want cell borders. I want text to be copied as a sentence/paragraph. Can someone please help me with this.

Here is the code i'm using:

Public Sub CommandButton1_Click()
    On Error GoTo ErrorHandler

Dim wApp As Word.Application
Dim wDoc As Word.Document

Set wApp = CreateObject("Word.Application.8")
wApp.Visible = True
Const strPath1 As String = "D:\Template.docx"
Set wDoc = wApp.Documents.Add(Template:=strPath1, NewTemplate:=False, DocumentType:=0)

Worksheets("Sheet2").Range(ActiveCell, ActiveCell.End(xlDown)).Copy

With wDoc.Paragraphs(wDoc.Paragraphs.Count).Range
         .Paste
End With

ErrorHandler:
        Resume Next
End Sub

Upvotes: 0

Views: 1367

Answers (1)

3-14159265358979323846264
3-14159265358979323846264

Reputation: 3290

You don't want to use copy and paste, you need to use the Excel VBA object model to reference the cell you want and then access the text using cell.Value.

You must already be using Excel.Application, and you must already be referencing the cell since you copy and paste the value, so swap the code you have to copy and paste with the code to use the cell.value.

Unfortunately, I'm not at my computer so I can't test this, but you want to replace your code with something like

Public Sub CommandButton1_Click()
    On Error GoTo ErrorHandler

Dim wApp As Word.Application
Dim wDoc As Word.Document

Set wApp = CreateObject("Word.Application.8")
wApp.Visible = True
Const strPath1 As String = "D:\Template.docx"
Set wDoc = wApp.Documents.Add(Template:=strPath1, NewTemplate:=False, DocumentType:=0)

Dim currentcell as variant
Dim result as string

For each currentcell in Worksheets("Sheet2").Range(ActiveCell, ActiveCell.End(xlDown))

    Result =result & currentcell.value & vbcrlf

Next currentcell

With wDoc.Paragraphs(wDoc.Paragraphs.Count).Range
         .Text= result
End With

ErrorHandler:
        Resume Next
End Sub

Upvotes: 1

Related Questions