Selecting a range and selecting a document to transfer it to

[DavidODonovan]

Hello to All,
I have a macro that opens a word document by requesting that I open the document. It then transfers data from an open excel workbook to the word document (in the given case below it is just cell A1). I want to get it to take a range of cells selected by the user and input these in the word file. The code to get a user defined range is as follows: Set SelectionRange = Application.InputBox(prompt:="Select Data Range", _ Type:=8)

So my question is, How do I get the above line of code to work in the macro below?



Public Sub ModifyWordDoc()

Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim wordRange As Word.Range
Dim sFilename As String
Dim SelectionRange As Range

Set wordApp = CreateObject("Word.Application")
sFilename = Application.GetOpenFilename(FileFilter:="Word documents (*.doc*), *.doc*")
wordApp.Visible = True
If sFilename = "False" Then Exit Sub



With wordApp
Set wordDoc = .Documents.Open(sFilename)
Set wordRange = wordDoc.Range

With wordRange
.Move wdStory, 1
.InsertAfter ThisWorkbook.Sheets(1).Range("A1").Value & vbCrLf
End With


.ActiveDocument.Save
.ActiveDocument.Close
.Application.Quit
End With

Set wordDoc = Nothing 'Not necessary here but good practice to minimise memory use in the case of several variables refering to the same object
Set wordApp = Nothing

MsgBox "Done: " & sFilename & " modified" & Space(10), vbOKOnly + vbInformation

End Sub

 

[patel45]

Public Sub ModifyWordDoc()

Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim wordRange As Word.Range
Dim sFilename As String
Dim SelectionRange As Range
Set myrange = Application.InputBox(prompt:="Select Data Range", Type:=8)
myrange.Copy
Set wordApp = CreateObject("Word.Application")

sFilename = Application.GetOpenFilename(FileFilter:="Word documents (*.doc*), *.doc*")
wordApp.Visible = True
If sFilename = "False" Then Exit Sub
With wordApp
  Set wordDoc = .Documents.Open(sFilename)
  Set wordRange = wordDoc.Range
  wordRange.Paste
  .ActiveDocument.Save
  .ActiveDocument.Close
  .Application.Quit
End With

Set wordDoc = Nothing 'Not necessary here but good practice to minimise memory use in the case of several variables refering to the same object
Set wordApp = Nothing

MsgBox "Done: " & sFilename & " modified" & Space(10), vbOKOnly + vbInformation

End Sub

 

[DavidODonovan]

Thank you patel45. I really appreciate your help

 

[snb_]

This macro suffices:

Public Sub M_snb()
   Application.InputBox(prompt:="Select Data Range", Type:=8).Copy
 
   with getobject(Application.GetOpenFilename(FileFilter:="Word documents (*.doc*), *.doc*"))
      .content.paste  
      .Close 1
   End With
End Sub

 

[patel45]

Ok snb_
very short, but .Close without 1.
This code replace the content of document, how can we append below the content ?

 

[DavidODonovan]

In word a macro to shift to the far right of an existing table of data and paste as new column is as follows.


Selection.EndKey Unit:=wdRow, Extend:=True
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Paste


This wont work as the 'Selection' is a column I have already copied from the word document. Any ideas?

This macro suffices:

Public Sub M_snb()
   Application.InputBox(prompt:="Select Data Range", Type:=8).Copy
 
   with getobject(Application.GetOpenFilename(FileFilter:="Word documents (*.doc*), *.doc*"))
      .content.paste  
      .Close 1
   End With
End Sub

 

[snb_]

To append:

Public Sub M_snb()
   Application.InputBox(prompt:="Select Data Range", Type:=8).Copy

   with getobject(Application.GetOpenFilename(FileFilter:="Word documents (*.doc*), *.doc*"))
      .content.insertafter vbcr
      .paragraphs.last.range.paste  
      .Close 1
   End With
End Sub

 

[patel45]

Thanks snb, it work well

 

[snb_]

To my amazement ...