Copy several ranges to Word with VBA, based on cell values

eivstei · Aug 30th 2020

Hi.

I want to copy several ranges in a workbook to one Word document. How do I do that with a VBA?

In this example, I have defined the ranges with names. In "sheet3", I want range F3:F20 to be cells that users can type in which name ranges they want to export to Word.

This code does work if the named range is in the same sheet as the button. But I need it to work when the named ranges are in another sheets.

I also need this code to copy next named range valued in the F3 cell, and down to end of list.

I appreciate your help

Code

Private Sub CommandButton3_Click()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document

Set WordApp = New Word.Application
Set WordDoc = WordApp.Documents.Add

Application.Range(Range("F3").Value).Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
WordApp.Visible = True
Set objSelection = WordApp.Selection
objSelection.Paste
End Sub

Display More

**royUK** · Aug 31st 2020

Welcome to Ozgrid, please read the Forum Rules to learn how to use the Forum correctly. I have added code tags this time.

**royUK** · Aug 31st 2020

I can't see how you determine where to paste the copied data.

Why do you need to copy to Word?

**royUK** · Aug 31st 2020

See if this does what you want

Code

Option Explicit


Private Sub CommandButton3_Click()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim iX As Integer
Dim sToWord As String


Set WordApp = New Word.Application
Set WordDoc = WordApp.Documents.Add


With ActiveSheet
For iX = 3 To 20


If Not IsEmpty(.Cells(iX, 6)) Then
sToWord = Range(.Cells(iX, 6).Value).Value
WordApp.Visible = True
With WordDoc.Paragraphs(ActiveDocument.Paragraphs.Count).Range
.InsertAfter Chr(9) & sToWord
.InsertParagraphAfter
End With
End If
Next iX
End With
End Sub

Display More

eivstei · Aug 31st 2020

Thank you for your reply.

I have a workbook template with closing accounts. Each month, several areas of this workbook will be copied into Word for presentation and printing.

To make copying more efficient, I want a VBA that copies the areas by the touch of a button. It should be possible for my colleagues to edit the areas to be copied, even if they have no knowledge of VBA. Therefore, I want the VBA to copy areas based on the values in the cells F3:F20. I do not know if it is best to define an area name or location (for example sheet1! B2: G10) in the F coloumn.

The code I have written will copy the named range valued in F3, and paste it as a picture in a new word document.

**royUK** · Aug 31st 2020

My code assumes that you have a list of named ranges. Have you tested it?

eivstei · Aug 31st 2020

Sorry, I did not see the "display more" function at first.

Now I tried your code, got an error. Please see the picture. Here I also illustrate how the workbook should work.

**royUK** · Aug 31st 2020

Does the name exist? Can you attach the actual workbook.

eivstei · Aug 31st 2020

Of course.

Thank you for the superquick reply

**royUK** · Sep 1st 2020

I can get the value from each range. I need to find a way to copy each range to word

eivstei · Sep 1st 2020

I guess we have to Select all the ranges and then copy all at once?

**royUK** · Sep 1st 2020

I'll get back to this as soon as I can

**royUK** · Sep 1st 2020

Try this

Code

Private Sub CommandButton3_Click()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim rng As Range, wdRng As Range, sht As Worksheet
Dim iX As Integer, p As Integer
Dim sToWord As String
Dim WordTable As Word.Table


Set WordApp = New Word.Application
Set WordDoc = WordApp.Documents.Add
WordApp.Visible = True
p = 1


With ActiveSheet
For iX = 3 To 20


If Not IsEmpty(.Cells(iX, 6)) Then
With ThisWorkbook.Names(.Cells(iX, 6).Value)
Set sht = Sheets(.RefersToRange.Parent.Name)
Set rng = sht.Range(.RefersToRange.Address)
rng.Copy
End With
With WordDoc
.Paragraphs(.Paragraphs.Count).Range.InsertParagraphAfter
.Paragraphs(.Paragraphs.Count).Range.Paste
End With
End If
Next iX
End With
MsgBox "Done", vbInformation
End Sub

Display More

eivstei · Sep 1st 2020

Wow, that code does work for several ranges! Thanks for the help so far.

To keep the format of the ranges, and to prevent any unauthorized changes to numbers, I would prefer it to be pasted as pictures to word.

I tried to change the code, but it was not as easy as I had hoped. Maybe it is for you?

**royUK** · Sep 1st 2020

I couldn't get it to work with images. It might be possible but I don't really know much Word VBA. Why not save the Word Document as a pdf?

eivstei · Sep 1st 2020

Ok, I will do some more research about that. But thank you so much royUK for your time and help. Your code is very helpfull. I will study it more and try to find a way to paste it ether as picture or make it work as it is. The code in my first post did save the range as pictures, so it should be possible.

But again, I am grateful for your commitment to help me.

**royUK** · Sep 1st 2020

I've got it to work now

Code

Private Sub CommandButton3_Click()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim rng As Range, wdRng As Range, sht As Worksheet
Dim iX As Integer, p As Integer
Dim sToWord As String
Dim WordTable As Word.Table


Set WordApp = New Word.Application
Set WordDoc = WordApp.Documents.Add
WordApp.Visible = True
p = 1


With ActiveSheet
For iX = 3 To 20


If Not IsEmpty(.Cells(iX, 6)) Then
With ThisWorkbook.Names(.Cells(iX, 6).Value)
Set sht = Sheets(.RefersToRange.Parent.Name)
Set rng = sht.Range(.RefersToRange.Address)
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
End With
With WordDoc
.Paragraphs(.Paragraphs.Count).Range.InsertParagraphAfter
.Paragraphs(.Paragraphs.Count).Range.Paste
End With
End If
Next iX
End With
MsgBox "Done", vbInformation
End Sub

Display More

eivstei · Sep 1st 2020

It works perfectly. Just as desired. Thank you very much for your solution.

**royUK** · Sep 1st 2020

I think it was an earlier attempt where I couldn't paste as image. Glad it works

Copy several ranges to Word with VBA, based on cell values

Participate now!

Share

Tags