Enival

Tenta isso Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim Nome As String Nome = Target.Value 'Guarda o nome On Error Resume Next If Target.Column <> 2 Or Target.Row < 4 Then GoTo Sair [B4:D115].Sort Key1:=[B4], Order1:=xlAscending 'Localiza na Plan1 a célula que tem o mome Set Endereço = Plan1.Range("B:B").Find(Nome) Seleção = Endereço.Address 'Define a selula da seleção Plan1.Range(Seleção).Select 'Seleciona a célula com o nome Sair: End Sub

Ola marlonrrosa, eu fiz uma bagunça com seus códigos Eu observei que você esta fazendo a busca por o número da chave Fazendo uso deste comando: 'Chaves = CHAVEbox.Value 'Set Rng9 = Sheets("BD_HISTORICO").Range("G:G").Find(Chaves) O problema é que no Histórico, pode conter duas ou mais vezes a chave número 01 ou 02 03 e vai então quando é feita a busca, o comando vai encontrar o chave na primeira posição A busca deve ser feita por um código único Acionei um botão com um código, espero ter ajudado Copia de CONTROLE DE CHAVE1.xlsm

Dim Escrito_na_célula_antes As String Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim LR As Long If Sh.Name = "DedoDuro" Then Exit Sub Application.EnableEvents = False With Sheets("DedoDuro") LR = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & LR + 1).Value = Format(Now, "dd-mm-yy hh:mm:ss") .Range("B" & LR + 1).Value = Sh.Name .Range("C" & LR + 1).Value = Target.Address(False, False) .Range("D" & LR + 1).Value = Escrito_na_célula_antes .Range("E" & LR + 1).Value = Target.Value .Range("F" & LR + 1).Value = Environ("USERNAME") End With Application.EnableEvents = True End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Sh.Name = "DedoDuro" Then Exit Sub Escrito_na_célula_antes = Target.Value

Olá Paloma, da uma olhada e ver se te serve PLANILHA EXEMPLO 12.xlsm

Boa tarde Lucas, da uma olhada no arquivo em anexo, para ver se te ajuda Pasta1(ENIVAL).xlsm

Olha a chamada da sua Macro Limpar, esta no BTCadastrar_Click Private Sub BTCadastrar_Click() Application.ScreenUpdating = False Cadastrar Limpar 'Tira daqui<<< Application.ScreenUpdating = True End Sub Coloca ele no fim da Macro Cadastrar Sub Cadastrar() Application.ScreenUpdating = True MsgBox "Fornecedor Cadastrado com sucesso", vbInformation, [D12] Limpar 'E coloca aqui>>> depois da mensagem assim ela só será chamada depois que todo processo for concluído End If End Sub

Diego, da uma olhada pra ver se era isso Gestão de RNC externa 2016 - BONSUCESSO teste1.xlsm

Olá bom dia Substitua a Macro inteira por esta. If Plan1.Range("H2").Value = "" Then 'Verifica se o campo esta vazio 'se o campo esta vazio, envia uma mensagen MsgBox "Por favor informe o nome para o campo!", vbExclamation, "Cancelado" Plan1.Range("H2").Activate 'Ativa a Célula H2 para que você informe o nome do campo Exit Sub Else 'Pega o nome informado em H2 da Plan1, e Nomeia o Intervalo ("I2 a K2 da Plan2") ActiveWorkbook.Names.Add Name:=Sheets("Plan1").[H1], RefersTo:="=Plan2!$I$2:$K$2" End If End Sub

Joás Lima, da uma olhada se te serve Public Sub Contador_Linhas_Colunas() 'Conta as linhas e colunas com valores LinhaAtual = 1 ColunaAtual = 1 Do 'Para Colunas Do 'Para Linhas Worksheets("Plan2").Cells(LinhaAtual, ColunaAtual + 7).Value = _ Worksheets("Plan2").Cells(LinhaAtual, ColunaAtual).Value LinhaAtual = LinhaAtual + 1 Loop Until Worksheets("Plan2").Cells(LinhaAtual, ColunaAtual).Value = "" LinhaAtual = 2 'linha volta ao valor inicial ColunaAtual = ColunaAtual + 1 Loop Until Worksheets("Plan2").Cells(LinhaAtual, ColunaAtual).Value = "" End Sub Public Sub Contador_Linhas_Colunas() 'Conta quantas linhas e ou colunas que você informa Dim x, y As Integer For x = 1 To 10 'Informe a quantidade de Colunas For y = 1 To 100 'Informe a quantidade de linhas Plan2.Cells(y, x).Value = y ' y = y + 1 Next y ' x = x + 1 Next x End Sub

Sub Macro2() 'Olá bom dia Eu dei uma olha nos códigos, observei que tanto um como o outro, se o campo [h2] não for preenchido vai da erro ' Macro2 Macro ' If Plan1.Range("H2").Value = "" Then MsgBox "Por favor informe o nome para o campo!", vbExclamation, "Cancelado" Plan1.Range("H2").Activate Exit Sub Else ActiveWorkbook.Names.Add Name:=Sheets("Plan1").[H1], RefersTo:="=Plan2!$I$2:$K$2" ' Range("I2:K2").Select ' ActiveWorkbook.Names.Add Name:=Range("H2"), RefersToR1C1:="=Plan2!R2C9:R2C11" End If End Sub