Copy and paste special from Excel to Word

[scorney]

Hello All,

I am looking to improve the output of this small VBA code below.
At this point I can copy and paste values without being a table in Word.

Now I want to add a carriage return or more between cells values.

Example.: A2 = ABC, B2= DEF, C2= GHI
The output in Word will be:
ABC DEF GHI

But I want:
ABC
DEF
GHI

This is the first step in this improvement. I also want to add a label on each item which the label reside on the spreadsheet and it is the first row. Each column has a specific label. But I am not there yet and have not tried.

A1= Site Name
B1= location
C1= Contact info

This is only an example as I have from A1 up to AG1, so lots of columns.

Sub myExcelToWord_1()
Dim myFileName As String
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
    Set wrdApp = CreateObject("Word.Application")
    Set wrdDoc = wrdApp.Documents.Add ' create a new document
'copy the Excel range to be pasted
    Range("A2:AG2").Copy
'specify name of the Word file and its full path
    myFileName = "LL_" & Range("F2") & ".docx"
    myPath = "C:\iForm" & myFileName
'paste special as unformated text
    With wrdDoc
    .Content.PasteSpecial Link:=True, DataType:=wdPasteText, Placement:= _
                    wdInLine, DisplayAsIcon:=False
'kill any file by the same name in the folder
            If Dir(myPath) <> "" Then
               Kill myPath
            End If
'save and close the Word document
        .SaveAs (myPath)
        .Close
    End With
wrdApp.Quit
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
Application.CutCopyMode = False
Range("A1").Select
End Sub

Thanks,
Sylvain

 

[Macropod]

Since you're using .PasteSpecial Link:=True, you can't do that when you copy/paste multiple cells in one go; you would need to use a loop and paste each cell individually. Alternatively, if you don't need the link, you could use:

Sub myExcelToWord_1()
Dim myFileName As String
Dim wrdApp As New Word.Application
Dim wrdDoc As Word.Document
With wrdApp
  Set wrdDoc = .Documents.Add ' create a new document
  'copy the Excel range to be pasted
  Range("A2:AG2").Copy
  With wrdDoc
    'paste special as unformated text
    .Range.PasteSpecial Link:=False, DataType:=wdPasteText, _
      Placement:=wdInLine, DisplayAsIcon:=False
    'Convert to one column
    .Range.Text = Replace(.Range.Text, vbTab, Chr(11))
    'save & overwrite any existing file
    .SaveAs2 Filename:="C:\iForm" & "LL_" & Range("F2") & ".docx", _
        FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    .Close
  End With
  .Quit
End With
Set wrdDoc = Nothing: Set wrdApp = Nothing
Application.CutCopyMode = False
End Sub

Note the various other code improvements.