Erro ao tentar copiar um range

Boa tarde a todos(as), Tenho uma tabela que e gerada a partir de uma outra, por isso o numero de linha varia. Criei o seguinte código para copiar essa planilha e aplicar ela em um documento word:

Private Sub CommandButton1_Click()
If Me.TextBox1.Value = "" Or Me.TextBox2.Value = "" Or Me.TextBox3.Value = "" Or Me.TextBox4.Value = "" Then

MsgBox "É necessario preencher os campos...", vbInformation, "Informação"

TextBox1.SetFocus

Exit Sub
End If

Dim Planilha As Range
Dim Celula As Range


Sheets("Planilha cliente").Activate
Range("J1048576").Select
ActiveCell.End(xlUp).Select
ActiveCell.Offset(0, 2).Select
Set Celula = ActiveCell

Planilha = Range("b3", "Celula").Copy


Dim Word As Word.Application
Dim DOC As Word.Document

Set Word = CreateObject("Word.Application")
Word.Visible = True

Set DOC = Word.Documents.Open("C:\contrato\contrato_modelo.docx")

    With DOC

        .Application.Selection.Find.Text = "#NOME"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = UCase(Me.TextBox1)

        .Application.Selection.Find.Text = "#RG_CNPJ"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = UCase(Me.TextBox2)

        .Application.Selection.Find.Text = "#Rua"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = UCase(Me.TextBox3)

        .Application.Selection.Find.Text = "#Bairro"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = UCase(Me.TextBox4)

        .Application.Selection.Find.Text = "#Cidade"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = UCase(Me.TextBox5)

        .Application.Selection.Find.Text = "#Telefone"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = UCase(Me.TextBox6)

        .Application.Selection.Find.Text = "#Planilha"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = Planilha

        .Application.Selection.Find.Text = "#DataProposta"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = Date

        .Application.Selection.Find.Text = "#DataEntrega"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = UCase(Me.TextBox7)
    If Dir("C:\contrato\Contrato1.docx") <> "" Then

        Kill "C:\contrato\Contrato1.docx"

        End If

        .SaveAs2 ("C:\contrato\Contrato1.docx")


    End With


    MsgBox "Procedimento não concluído! Verifique novamente...", vbCritical, "Error"

    Exit Sub



        Set DOC = Nothing
        Set Word = Nothing
         Workbooks.Open Filename:="C:\contrato\Contrato1.docx"
End Sub

Porem, ele da erro na hora de copiar o Range e atribuir a variável planilha. como posso fazer um range usando uma célula conhecida e uma célula selecionada?