wesoliveiraa

Marcos, muito obrigado pela ajuda! Consegui resolver adicionando um If no começo do macro.

If Range("E9") = "Equipamento Técnico" Then

Range("H3").Select
    Selection.Copy
    Sheets("Manutenção Preventiva").Select
    Range("T_Manutenção[Equipamento]").Select
    
    'Procura Célula Vazia
    Do
    If Not (IsEmpty(ActiveCell)) Then
      ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
    
    'Volta o Código de cópia
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Cadastro de Patrimônio").Select
End If
 

Atualmente, preencho a planilha Cadastro de Patrimônio e clico no gravar. O macro do botão gravar copia e cola as informações em suas respectivas colunas na tabela T_Patrimônio. 

Eu gostaria que o botão Gravar, além da função que já tem, copiasse a informação Patrimônio para coluna "Equipamento", em Manutenção preventiva, se o campo Tipo for igual a "Equipamento Técnico". 

Muito obrigado!

Bom dia, Marcos! Coloquei a planilha em anexo. Obrigado

Boa dia! Sou novo no fórum e no VBA. Na calma e na pesquisa, vou aprendendo e evoluindo. Minha dúvida dessa vez é a seguinte:

Tenho uma planilha de cadastro de patrimônio que após preencher e clicar no botão "Inserir", os dados são copiados pra uma tabela. Agora eu preciso que esse mesmo botão também copie os dados pra outra tabela, mas só quando o tipo do patrimônio foi "Equipamento Técnico". Alguém poderia me dar uma luz de por onde começar?

Sub CadastroOK()
'Copy Número do Patrimônio
    Range("E3").Select
    Selection.Copy
    Sheets("Patrimônio").Select
    Range("T_Patrimônio[Número]").Select
    
   'Procura Célula Vazia
    Do
    If Not (IsEmpty(ActiveCell)) Then
      ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
    
   'Volta o Código de cópia
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Cadastro de Patrimônio").Select
   'Limpa Células
    Range("E3").ClearContents
End Sub

Patrimônio.rar