Home > Software design >  How do I paste a range of cells from Excel into Word using VBA
How do I paste a range of cells from Excel into Word using VBA

Time:05-02

I'm trying to make a macro in excel that will copy data from a range into a word document, I'll also need to be able to format the word document, but I'll figure that out once I figure out how to select the newly created word document and paste my selection into it.

so far I have

'opening the word document
Dim oWord As Object
Set oWord = CreateObject(Class:="Word.Application")
oWord.Visible = True

oWord.Documents.Add 'ADD A BLANK DOCUMENT.
oWord.Activate 'ACTIVATE.

'copy info for word
Sheets("FORMAT").Select
Range("L2:L141").Select
Selection.Copy
oWord.document.Select
Selection.Paste

it's specifically that oWord.document.select that doesn't work, what do I need to replace it with to select the word document to paste into?

here's the full code, and it's literally the first time i've ever coded anything, so any critics are most welcome.

'for loop of copying and pasting cells from the format sheet to the message sheet.
Public Sub Message_Preview_updater()
        
    'Updates the table sheet
    Sheets("message").Select
    Range("A2:F101").Select
    Selection.Copy
    Sheets("Table").Select
    Range("A2:F101").Select
    ActiveSheet.Paste
    
    'prepares the range to paste the loop into and all the necessary variables for the loop
    Dim FillCounter As Integer
    Dim Blanks As Integer
    Sheets("FORMAT").Select
    Range("L2:L141").ClearContents
    Blanks = 0
    
    'Tests format preview cells for values and then pastes in column J skipping blank cells
    For FillCounter = 2 To 141 Step 1
        If Cells(FillCounter, 10).Value <> "" Then
            Cells((FillCounter - Blanks), 12) = Cells(FillCounter, 10).Value
        
        'tests format preview cells for blanks then adds 1 to LogBlanks
        ElseIf Cells(FillCounter, 10).Value = "" Then
            Blanks = Blanks   1
        
        End If
    
    Next FillCounter
    
    'finally updates Message preview
    Sheets("FORMAT").Select
    Range("L2:L141").Select
    Range("L141").Activate
    Selection.Copy
    Sheets("Message").Select
    Range("I4").Select
    ActiveSheet.Paste
    '
    '================================
    '= now paste into word doc time =
    '================================
    '
    'opening the word document
    Dim oWord As Object
    Set oWord = CreateObject(Class:="Word.Application") 'INITIALIZE THE OBJECT.
    oWord.Visible = True 'OPEN THE WORD FILE.

    oWord.Documents.Add 'ADD A BLANK DOCUMENT.
    oWord.Activate 'ACTIVATE.

    'copy info for word
    Sheets("FORMAT").Select
    Range("L2:L141").Select
    'Range("L141").Activate
    Selection.Copy
    oTable.Select
    Selection.paste 

End Sub

CodePudding user response:

Copy (Excel) Range to New Word Document

  • For this to work, you need to enable Tools > References > Microsoft Word 16.0 Object Library (16.0 could be different in your Office version).
  • By using this reference (aka early binding - recommended) you are enabling the Word's intelli-sense in Excel.
Option Explicit

Sub CopyRangeToNewWord()
    On Error GoTo ClearError
    
    Const wdFolderPath As String = "C:\Test\"
    Const wdFileName As String = "Test.docx"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Worksheets("Format")
    Dim rg As Range: Set rg = ws.Range("L2:L141")
    
    ' Reference the Word Application.
    
    Dim wdApp As Word.Application
    Dim WordWasClosed As Boolean
    
    ' 1. Attempt to create a reference (check if it is open).
    On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
    On Error GoTo ClearError
    
    ' 2. If no reference, open and create a reference to it.
    If wdApp Is Nothing Then ' Word is closed
        Set wdApp = New Word.Application
        WordWasClosed = True
        wdApp.Visible = True ' uncomment when done testing
    'Else ' Word is open and referenced; do nothing
    End If
    
    ' Open and reference a new word document.
    Dim wdDoc As Word.Document: Set wdDoc = wdApp.Documents.Add
    
    ' Copy/Paste.
    rg.Copy
    wdDoc.Paragraphs(1).Range.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=True, _
        RTF:=False
    Application.CutCopyMode = False
    
    ' Continue modifying the Word document...
    
    
SafeExit:
    On Error Resume Next
        ' Save and close the Word document.
        If Not wdDoc Is Nothing Then ' overwrite without confirmation
            wdDoc.SaveAs2 wdFolderPath & wdFileName, wdFormatDocumentDefault
        End If
        ' Quit the Word application...
        If WordWasClosed Then ' ... if it initially was closed
            If Not wdApp Is Nothing Then wdApp.Quit
        'Else ' ... if it initially was open, don't quit; do nothing
        End If
    On Error GoTo 0
    
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit
End Sub
  • Related