Copiar planilha do Excel e colar em um Documento do Word

Boa noite a todos
Pessoal sou aprendiz no VBA, estou criando uma planilha de orçamentos no Excel, a qual a mesma ao finalizar o orçamento me gere um arquivo em PDF para ser enviado por e-mail ao cliente.
Minha duvida é em como colar uma planilha do Excel em um documento do Word?
No código a seguir o VBA me abre um documento do Word edita o inicio do documento, porém quando vou colar uma linha de uma planilha no documento aberto, é apagado todas as informaçoes contidas no mesmo.
E minha real intenção e adicionar a tabela junto ao texto.
Alguém pode me ajudar por gentileza.
segue código VBA

Sub Word()

Dim Word As Word.Application
Dim Doc As Word.Document



Set Word = CreateObject("Word.Application")
Word.Visible = True
Set Doc = Word.Documents.Open("C:\Users\Ivan_\Documents\Projeto VBA\Proposta Comercial Vivo Empresas.docx")



With Doc

.Application.Selection.Find.Text = "#Empresa"
.Application.Selection.Find.Execute
.Application.Selection.Range = UCase(Txt_Empresa)

.Application.Selection.Find.Text = "#nome_do_contato"
.Application.Selection.Find.Execute
.Application.Selection.Range = UCase(Txt_nome_do_contato)

End With
'----------------------------------------------------------

Set w = Sheets("Plan1")
w.Select
w.Range("B4").Select



If ActiveCell.Value > 0 Then
ActiveCell.Offset(0, 2).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
Set Copy = Doc.Content <<<<<<<<<<<<<<'aqui esta o erro, antes desse comando tudo roda certinho, quando esse comando é acionado ele apaga tudo no documento e copia só a tabela
Copy.Paste
Application.CutCopyMode = False
ActiveCell.Offset(1, 1).Select

End If

Sub Word()

Dim Word As Word.Application
Dim Doc As Word.Document



Set Word = CreateObject("Word.Application")
Word.Visible = True
Set Doc = Word.Documents.Open("C:\Users\Ivan_\Documents\Projeto VBA\Proposta Comercial Vivo Empresas.docx")



With Doc

.Application.Selection.Find.Text = "#Empresa"
.Application.Selection.Find.Execute
.Application.Selection.Range = UCase(Txt_Empresa)

.Application.Selection.Find.Text = "#nome_do_contato"
.Application.Selection.Find.Execute
.Application.Selection.Range = UCase(Txt_nome_do_contato)

.Application.Selection.Find.Text = "@Empresa"
.Application.Selection.Find.Execute
.Application.Selection.Range = UCase (Txt_Empresa)



End With
'----------------------------------------------------------

Set w = Sheets("Plan1")
w.Select
w.Range("B4").Select



If ActiveCell.Value > 0 Then
ActiveCell.Offset(0, 2).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
End If

With Doc
.Application.Selection.Paste 'resolvido
End With

Application.CutCopyMode = False
ActiveCell.Offset(1, 1).Select



If ActiveCell.Value = "" Then
ActiveCell.Offset(1, 0).Select

End If

With Doc
.Application.Selection.Find.Text = "#Proposta Comercial Vivo Empresas"
.Application.Selection.Find.Execute
.Application.Selection.Range = "Proposta Comercial Vivo Empresas"
End With

End Sub

Boa noite, e bem-vindo ao fórum
Por se tratar de assunto fora do Acess, movo-lhe para a sala off-topic
Boas Festas para si e sua família