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