Macro para copiar dados

[Iurigdn]

Podem me ajudar com algo bem simples, mas que não estou conseguindo de jeito nenhum.

 

Preciso que ao inserir um valor na célula B11 seja somado com  a célula B4 e apagado o valor da B11.

 

Obrigado

[Visitante]

Instale o código abaixo no módulo da planilha, assim:
1. copie o código daqui
2. clique com o direito na guia da planilha de interesse e escolha 'Exibir código'
3. cole o código na janela em branco que vai se abrir
4. feito! 'Alt+Q' para retornar para a planilha e testar

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address <> "$B$11" Then Exit Sub
    Application.EnableEvents = False
      [b4] = [b4] + [b11]
      [b11].ClearContents
    Application.EnableEvents = True
End Sub

 

[Iurigdn]

Osvaldo,

 

deu certo, mas precisava fazer isso com a E11 p/ E4 também. Achei que fosse conseguir, mas não deu certo

 

Estou quebrando a cabeça já a um tempão e não consigo sair do lugar. Será que se eu anexar aqui a planilha você pode me ajudar a fazer o que eu preciso? São coisas simples, mas eu sou muito leigo.

Coloquei o comando abaixo em uma planilha que fiz do zero e está dando erro.

 

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$11" Then
    [b4] = [b4] + [b11]: [b11] = ""
  ElseIf Target.Address = "$E$11" Then
    [E4] = [E4] + [E11]: [E11] = ""
  End If

End Sub

 

Erro em tempo de execução '-2147417848 (80010108)':

 

O método '_Default' do objeto 'Range' falhou

Osvaldo,

 

Fiz duas planilhas de teste para tentar fazer isso e nenhuma das duas está dando certo.

 

O que será que estou fazendo de errado?

 

Vou anexar a planilha correta também para você entender melhor o que eu preciso

testes.rar

[Visitante]

Amigão, tá funcionando normal aqui.

 

coisa estranha, um outro usuário postou  uma questão EXATAMENTE IGUAL a sua, tratando de um arquivo EXATAMENTE IGUAL ao seu... veja no link abaixo

 

 

estranha coincidência...

[Iurigdn]

Eu estou precisando tanto que postei lá, ninguém respondeu, ai perguntei aqui.

 

Você testou na que eu te mandei mesmo?

[Visitante]

 

Você testou na que eu te mandei mesmo?

Sim. Testei os códigos dos posts #2 e #3 no arquivo que você postou e ambos funcionam.

[Iurigdn]

Neste código da erro onde está em vermelho. Se eu substituir B11 por B12 não dá erro, mas não apaga a o valor da célula.

Fiz teste em outro computador também e o erro é o mesmo:

Erro em tempo de execução '-2147417848 (80010108)':

O método '_Default' do objeto 'Range' falhou

 

Private Sub Worksheet_Change(ByVal Target As Range)

  If Target.Address = "$B$11" Then
    [b4] = [b4] + [b11]: [b11] = ""
  ElseIf Target.Address = "$E$11" Then
    [E4] = [E4] + [E11]: [E11] = ""
  End If

End Sub

[Visitante]

Experimente asim:

 

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$11" Then
    Range("B4").Value = Range("B4").Value + Range("B11").Value
    Range("B11").ClearContents
  ElseIf Target.Address = "$E$11" Then
    Range("E4").Value = Range("E4").Value + Range("E11").Value
    Range("E11").ClearContents
  End If
End Sub

 

 

[Iurigdn]

Experimente asim:

Osvaldo, agora sim deu certo! 

Mas a outra não acontece nada, clico no botão Inserir Dados e não vai nenhuma informação nem apresenta erro.

 

Sub InserirDados()

  Dim LR As Long

    If Application.CountA(Range("H4:K4")) < 3 Or _

      Application.CountA(Range("I4:J4")) = 2 Then Exit Sub

      With Sheets("Dados")

        LR = .Cells(Rows.Count, 2).End(xlUp).Row

        .Cells(LR + 1, 2).Resize(, 5).Value = Range("H4:L4").Value

      End With

      Range("H4:K4") = ""

End Sub

[Visitante]

Você seguiu a sequência do post #3 do outro fórum ( estranha coincidência... ) ?

 

Se seguiu e ainda assim não funciona, sugiro que você diponibilize o seu arquivo com o código instalado, aí tentaremos idenficiar o problema que você está encontrando.

[Iurigdn]

Você seguiu a sequência do post #3 do outro fórum ( estranha coincidência... ) ?

 

Se seguiu e ainda assim não funciona, sugiro que você diponibilize o seu arquivo com o código instalado, aí tentaremos idenficiar o problema que você está encontrando.

Exatamente. Segue em anexo.

controle-ent-sai-cxepstv7.rar

[Visitante]

Considerando o código colocado no post #9:

If Application.CountA(Range("H4:K4")) < 3
o comando acima tem o objetivo de impedir a transferência do registro caso não sejam preenchidas ao menos 3 das 4 células no intervalo "H4:K4", que você alterou para "H4:L4". Como na célula "L4" há uma fórmula então essa célula sempre estará preenchida, portanto não há necessidade de verificar o seu preenchimento no instante da transferência do registro. Sugiro que você mantenha "H4:K4", mas se quiser incluir "L4" altere também a referência, assim: "H4:L4" < 4


Application.CountA(Range("I4:J4")) < 2
o comando acima tem o objetivo de impedir a transferência do registro caso fossem preenchidas as células "I4" e "J4", ou seja, imaginei que cada registro seria destinado à saída ou de Caixas ou de Pastas. Mas no  arquivo que você colocou no post #11 o registro trata do envio de Caixas e Pastas. É por causa deste comando que o código não está fazendo a transferência do registro. Nessa situação de enviar Caixas e ou Pastas, altere o comando para : Application.CountA(Range("H4,K4")) < 2 . Assim estará garantido o preenchimento da Data, do Código, e também ou Caixas e ou Pastas.

O código com as alterações ficaria conforme abaixo. Faça os testes.

Sub InserirDados()  Dim LR As Long    If Application.CountA(Range("H4:K4")) < 3 Or _      Application.CountA(Range("H4,K4")) < 2 Then Exit Sub      With Sheets("Dados")        LR = .Cells(Rows.Count, 2).End(xlUp).Row        .Cells(LR + 1, 2).Resize(, 5).Value = Range("H4:L4").Value      End With      Range("H4:K4") = ""End Sub

 

[Iurigdn]

Osvaldo,

 

Obrigado mais uma vez!

 

Apenas coloquei para diminuir o estoque quando clica em inserir e funcionou do jeito que precisava.