De excel a word como imagen

[Hola

Mira esta forma:

Sub CopiarPegar()
Dim Hoja As Worksheet
Dim MiRango As Range
Dim MiImagen As Chart
Dim ruta$
Dim MiappWord As Object
Let ruta = ThisWorkbook.Path & "\grafico.bmp"
Set MiappWord = CreateObject("Word.Application")
MiappWord.Documents.Add
For Each Hoja In Worksheets
    Set MiRango = Hoja.Range("A1:H20")
    With MiRango
        .CopyPicture Appearance:=xlScreen, Format:=xlPicture
        Set MiImagen = MiRango.Parent.ChartObjects.Add(10, 10, .Width, .Height).Chart
    End With
    With MiImagen
        .Parent.Activate
        .Paste
        .ChartArea.Border.LineStyle = 0
        .ChartArea.Width = MiImagen.ChartArea.Width * 2
        .ChartArea.Height = MiImagen.ChartArea.Height * 2
    End With
    MiImagen.Export Filename:=ruta, FilterName:="BMP"
    With MiappWord
        .Selection.InlineShapes.AddPicture Filename:=ruta, LinkToFile:=False, SaveWithDocument:=True
        .Selection.InsertNewPage
    End With
    Application.CutCopyMode = False
    MiImagen.Parent.Delete
    Kill ruta
    Set MiRango = Nothing
    Set MiImagen = Nothing
Next Hoja
MiappWord.Visible = True
Set MiappWord = Nothing
MsgBox "Todo listo"
End Sub

Ojo a varias cosas: Estoy asumiendo que se copian los datos de todas las hojas sin excepción; ajusta el rango al deseado, no olvides activar la referencia a "Microsoft Word 16.0 Object Library" en donde el 16.0 puede variar dependiendo de tu versión de Office.

Comentas

Abraham Valencia

hola Abraham

Me da error en la fila 

.CopyPicture Appearance:=xlScreen, Format:=xlPicture

Gracias

¿Qué versión de Excel usas? ¿Qué error exactamente te da? ¿Seguro qué en esa línea? ¿Hiciste algún cambio? Etc.

Abraham Valencia

en el libro cambia el numero de hojas en este momento tengo 652.  

el rango se mantiene igual para todas las hojas, ya active la librería "Microsoft Word 15.0 Object Library" 

Excelente solución, lo probé en un libro nuevo y funciono perfecto.

Gran experto.