Boa tarde pessoal, gostaria de pedir uma ajudinha a vocês.

Tô com um serio problema, preciso criar uns 300 contratos e estou tentando fazer de uma forma automatizada com o excel e vba, com campos e botoes. O excel vai receber as informações como se fosse um bd e substituir as variáveis no texto do contrato que esta no word. Meu codigo saiu mais ou menos assim:

Private Sub CommandButton2_Click()

End Sub

Private Sub CommandButton3_Click()

End Sub

'botão editar

Private Sub bt_editar_Click()

lbl_informacao = "Atenção... Modo atualização de dados"

For x = 1 To Me.ListBox1.ListItems.Count
    
    If Me.ListBox1.ListItems.item(x).Checked Then
          
    'limpa
    Call limpar_campos
        
    'Muda a cor
    Dim objeto As Control

    For Each objeto In Me.Controls 'faz o looping percorrendo todos os objetos do Userform1
    If TypeName(objeto) = "TextBox" Or TypeName(objeto) = "ComboBox" Then ' se o tipo do objeto encontrado tiver o nome TEXTBOX
            objeto.BackColor = &HC0FFFF     'limpa muda a cor
            End If
    Next objeto
    Call carregar_campos
        
    End If
    
Next x


End Sub

'botão excluir
Private Sub bt_excluir_Click()
Call bt_editar_Click

Dim contador As Integer
Dim linha As Integer


Plan1.Select
Do Until Plan1.Cells(linha, 1) = ""
  'condicção para localizar o código
  If Plan1.Cells(linha, 1) = id Then
     Plan1.Cells(linha, 1).Select
     
     Dim resposta As String 'cria a variável resposta
     resposta = MsgBox("O registro será excluído. Confirma a exclusão?", vbYesNo) 'cria a mensagem para determinar qual ação será executada
        
        If resposta = vbYes Then ' se a resposta for sim então
     
       'comando para deletar toda a linha
        ActiveCell.Rows("1:1").EntireRow.Select
        Selection.Delete Shift:=xlUp
        ActiveCell.Select
        
        'limpa todos os campos do formulário
        ActiveWorkbook.Save
        MsgBox ("Registro excluído com sucesso!!!")
        Call UserForm_Initialize
        
        Else
        End If
        
   End If
   
linha = linha + 1

Loop

Call limpar_campos

'Muda a cor
    Dim objeto As Control

    For Each objeto In Me.Controls 'faz o looping percorrendo todos os objetos do Userform1
    If TypeName(objeto) = "TextBox" Or TypeName(objeto) = "ComboBox" Then ' se o tipo do objeto encontrado tiver o nome TEXTBOX
            objeto.BackColor = &H80000005     'limpa muda a cor
            End If
    Next objeto

'renumera id
 
 
    
    lbl_informacao = ""
    

    Plan1.Cells(2, 1).Select
    Do Until ActiveCell.Offset(0, 1) = ""
    
    If ActiveCell.Offset(0, 1) <> "" Then
    contador = contador + 1
    ActiveCell = contador
    ActiveCell.Offset(1, 0).Select
    Else
    Call UserForm_Initialize
    Exit Sub
    End If
    Loop

    Call UserForm_Initialize 'para puxar o valor do registro
End Sub

Private Sub bt_novo_Click()

End Sub

'botão sair

Private Sub bt_sair_Click()
Unload Me
End Sub

'botão salvar --------------------------tem queser editado

Private Sub bt_salvar_Click()
Dim data As Date

Dim id As Integer
Dim contrato As String


Dim linha As Integer

'se estiver no modo atualização irá executar a macro correspondente
If lbl_informacao = "Atenção... Modo atualização de dados" Then
    
    Exit Sub
End If

On Error Resume Next


Plan1.Select 'seleciona a Plan5
Range("A30000").Select 'seleciona a ultima linha da Plan5
Selection.End(xlUp).Select 'sobe até o primeira célula com conteúdo
ActiveCell.Offset(1, 0).Select 'desce para célula em branco
linha = ActiveCell.Row 'captura na variável o valor da linha atual

With Plan1


.Cells(linha, 1) = txt_cam_nome_com
.Cells(linha, 2) = txt_cam_cpf_com
.Cells(linha, 3) = txt_cam_rg
.Cells(linha, 4) = txt_cam_uf
.Cells(linha, 5) = txt_cam_endereco
.Cells(linha, 6) = txt_cam_preco_total
.Cells(linha, 7) = txt_cam_entrada
.Cells(linha, 8) = txt_cam_parcela
.Cells(linha, 9) = txt_cam_qt_meses

End With
     
     MsgBox ("Dados Cadastrados com sucesso!!!")
     ActiveWorkbook.Save
     Unload Me
     UserForm1.Show
End Sub

'botao do word ------------------------------------tem que editar

Private Sub bt_word_Click()
Dim Word As Word.Application
    Dim DOC As Word.Document
    
    Set Word = CreateObject("Word.Application")
    Word.Visible = True
    
    Set DOC = Word.Documents.Open("C:Testecontrato_modelo_lis.docx")
    
    With DOC
        '*Dados locador
        .Application.Selection.Find.Text = "#comprador"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cam_nome_com
        
        .Application.Selection.Find.Text = "##cpf_comprador"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cam_cpf_com
               
        .Application.Selection.Find.Text = "#rg_comprador"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cam_rg
         
        .Application.Selection.Find.Text = "#uf_rg"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cam_uf
        
        .Application.Selection.Find.Text = "#endereco"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cam_endereco
               
        .Application.Selection.Find.Text = "#preco_total"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cam_preco_total
       
        .Application.Selection.Find.Text = "#valor_entrada"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cam_entrada
        
        .Application.Selection.Find.Text = "#valor_parcela"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cam_parcela
        
        .Application.Selection.Find.Text = "#qt_meses"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cam_qt_meses
        
        .Application.Selection.Find.Text = "#cidade"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cam_cidade
        
        .Application.Selection.Find.Text = "#data"
        .Application.Selection.Find.Execute
        .Application.Selection.Range = txt_cam_data
        
        
        If Dir("C:Testecontrato2.docx") <> "" Then
          Kill "C:Testecontrato2.docx"
        End If
        .SaveAs ("C:Testecontrato2.docx")
        '.Close
    End With
    
    'WORD.Quit
    Set DOC = Nothing
    Set Word = Nothing
End Sub

Private Sub cam_entrada_Change()

End Sub

Private Sub cam_nome_com_Change()

End Sub

Private Sub Label1_Click()

End Sub

Private Sub Label4_Click()

End Sub

Private Sub Label5_Click()

End Sub

Private Sub ToggleButton1_Click()

End Sub

Private Sub TextBox5_Change()

End Sub

Private Sub TextBox6_Change()

End Sub


Private Sub ListBox1_Click()

End Sub


Private Sub ListView1_ItemCheck(ByVal item As MSComctlLib.ListItem)

bt_limpar.Locked = False
bt_editar.Locked = False
bt_excluir.Locked = False

''Vai permitir a seleção de apenas um item da listview para excluir ou editar

ListView1.ListItems(item.Index).Selected = True 'seleciona o item marcado

For i = 1 To ListView1.ListItems.Count

    If ListView1.ListItems(i).Selected = True Then 'se o item estiver selecionado o check também ficará marcado
    ListView1.ListItems.item(i).Checked = True
    Else
    ListView1.ListItems.item(i).Checked = False 'se não vai desmarcar o item

End If

Next i

End Sub


Private Sub UserForm_Initialize()

'Remove_bordas Me

Dim contador As Integer
Dim linha As Integer
'
'
With ListView1
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
.ColumnHeaders.Add Text:="Nome", Width:=115
.ColumnHeaders.Add Text:="C.P.F", Width:=70, Alignment:=2
.ColumnHeaders.Add Text:="R.G", Width:=60, Alignment:=0
.ColumnHeaders.Add Text:="U.F", Width:=28, Alignment:=2
.ColumnHeaders.Add Text:="Endereço", Width:=120, Alignment:=2
.ColumnHeaders.Add Text:="P. Total", Width:=28, Alignment:=0
.ColumnHeaders.Add Text:="V. Entrada", Width:=28, Alignment:=2
.ColumnHeaders.Add Text:="V. Parcela", Width:=28, Alignment:=2
.ColumnHeaders.Add Text:="Qt. Meses", Width:=28, Alignment:=2
End With

''Adiciona os dados a listview

Plan1.Select

linha = 2

        ListView1.ListItems.Clear

        Do Until Plan1.Cells(linha, 1) = ""

         Set li = ListView1.ListItems.Add(Text:=Plan1.Cells(linha, 1).Value) 'ID
         li.ListSubItems.Add Text:=Plan1.Cells(linha, 2).Value
         li.ListSubItems.Add Text:=Plan1.Cells(linha, 6).Value
         li.ListSubItems.Add Text:=Plan1.Cells(linha, 8).Value
         li.ListSubItems.Add Text:=Plan1.Cells(linha, 9).Value
         li.ListSubItems.Add Text:=Plan1.Cells(linha, 13).Value
         li.ListSubItems.Add Text:=Plan1.Cells(linha, 15).Value
         li.ListSubItems.Add Text:=Plan1.Cells(linha, 31).Value
         li.ListSubItems.Add Text:=Plan1.Cells(linha, 18).Value
         linha = linha + 1


        Loop

  lbl_registros = "Contratos: " & Me.ListView1.ListItems.Count

Plan1.Select
Range("A30000").Select
Selection.End(xlUp).Select 'sobe até o primeira célula com conteúdo
If ActiveCell = "ID" Then
contador = 0
Else
contador = ActiveCell.Value 'captura na variável o valor da linha atual
End If

contador = contador + 1
txt_id = contador



End Sub


Sub carregar_campos()

Dim id As Integer
Dim linha As Integer

id = txt_id
linha = 2

Plan1.Select
    
    Do Until Plan1.Cells(linha, 1) = "" 'vai executar o laço até encontrar uma célula vazia
    'condicção para localizar o registro
    
    If Plan1.Cells(linha, 1) = id Then 'se encontrar o valor registro na célula pesquisada
    Plan1.Cells(linha, 1).Select 'será selecionada a célula
    linha = ActiveCell.Row 'captura na variável o valor da linha atual

     
    With Plan1
    
    
        txt_cam_nome_com = .Cells(linha, 1)
        txt_cam_cpf_com = .Cells(linha, 2)
        txt_cam_rg = .Cells(linha, 3)
        txt_cam_uf = .Cells(linha, 4)
        txt_cam_endereco = .Cells(linha, 5)
        txt_cam_preco_total = .Cells(linha, 6)
        txt_cam_entrada = .Cells(linha, 7)
        txt_cam_parcela = .Cells(linha, 8)
        txt_cam_qt_meses = .Cells(linha, 9)
        
        
       
        
        Exit Sub
    End With
     
         
    End If
    
    linha = linha + 1
    Loop
End Sub

Só que estou com um sério problema na hora de executar, ja revisei o codigo todo e não achei o erro. Gostaria de um help de vocês. =)

Muito obrigado pela ajuda pessoal.