Ir para conteúdo
  • Cadastre-se

A partir do dia 19/11/2018, o foco do Fórum do BABOO é apenas Windows e Segurança Digital conforme informado no início de 2018.
As áreas que não têm relação com esses dois assuntos foram arquivadas e seus tópicos estão disponíveis para consulta na área Tópicos Antigos.

Conheça as novidades de 2019 para o BABOO e Fórum do BABOO

gabrielkakarotto

Ajuda com Macro

Mensagem Recomendada

Olá galera blz?

 

 

Preciso de uma ajuda para uma planilha da empresa..

É o seguinte.. criei um macro para atualizar o cadastro pelo filtro, pois foi a forma mais facil que achei

Só que não esta dando certo

 

Funciona assim..

O macro vai copia o nome do funcionário o que esta em uma planilha( Aba Cadastro ) e vai buscar no filtro na outra planilha (Funcionários) pelo nome e achando a linha com o nome ele copia os dados novos da planilha cadastro e cola na linha encontrada pelo filtro

 

Ok ele funciona, só que somente com o nome que fiz o macro, se eu tentar atualizar outro funcionário ele cola em cima da minha linha

E se eu tirar a refenrencia do meu nome do macro a baixo ele cria uma nova linha para esta novo funcionário

 

Resumindo, só funciona com o nome que fiz o macro..

 

Tem como resolver isso? Ou entao tem outra forma de atualizar sem ser pelo filtro?

Já tentei de tudo

 

Obrigado e desde já agradeço

PS: Planilha em anexo

 

Macro:

 

 

Sub Macro1()

'

' Macro1 Macro

'

 

'

    Selection.Copy

    Sheets("Funcionários").Select

    ActiveSheet.Range("$A$1:$I$14").AutoFilter Field:=1, Criteria1:= _

        "=Gabriel de Sena Bernardone", Operator:=xlAnd

    Sheets("Cadastro").Select

    Range("C2:C10").Select

    Application.CutCopyMode = False

    Selection.Copy

    Sheets("Funcionários").Select

    Range("A5").Select

    Application.CutCopyMode = False

    ActiveCell.FormulaR1C1 = "Gabriel de Sena Bernardone"

    Range("A5:I5").Select

    ActiveWindow.ScrollColumn = 3

    ActiveWindow.ScrollColumn = 2

    ActiveWindow.ScrollColumn = 1

    Sheets("Cadastro").Select

    Selection.Copy

    Sheets("Funcionários").Select

    Rows("5:5").Select

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

        False, Transpose:=True

    Sheets("Cadastro").Select

    Range("E10").Select

    Sheets("Funcionários").Select

    ActiveSheet.Range("$A$1:$I$14").AutoFilter Field:=1

    Range("A2").Select

Compartilhar este post


Link para o post
Compartilhar em outros sites

Funcionamento:
Após finalizar a entrada dos dados na planilha 'Cadastro', selecione a célula que contém o nome e rode o código.
Serão copiados e colados na planilha 'Funcionários' os dados de 'A' até 'I'.
Se o nome não for encontrado o código irá perguntar se deseja criar um novo registro.

Considerei que, nas duas planilhas, os nomes estão na coluna 'A'.
Coloque este código no lugar do existente.

Retorne se precisar de algum ajuste.


Sub AtualizaRegistro()
  Dim rngFunc As Range, LR As Long
    Set rngFunc = Sheets("Funcionários").[A:A].Find(ActiveCell.Value)
      If Not rngFunc Is Nothing Then
        Sheets("Funcionários").Cells(rngFunc.Row, 1).Resize(, 9).Value = _
          Cells(ActiveCell.Row, 1).Resize(, 9).Value
      ElseIf MsgBox("Nome não encontrado." & vbLf & "Deseja criar novo registro?", vbYesNo) = vbYes Then
        With Sheets("Funcionários")
          LR = .Cells(Rows.Count, 1).End(xlUp).Row
          .Cells(LR + 1, 1).Resize(, 9).Value = _
            Cells(ActiveCell.Row, 1).Resize(, 9).Value
        End With
      End If
End Sub

 


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites
Funcionamento:

Após finalizar a entrada dos dados na planilha 'Cadastro', selecione a célula que contém o nome e rode o código.

Serão copiados e colados na planilha 'Funcionários' os dados de 'A' até 'I'.

Se o nome não for encontrado o código irá perguntar se deseja criar um novo registro.

Considerei que, nas duas planilhas, os nomes estão na coluna 'A'.

Coloque este código no lugar do existente.

Retorne se precisar de algum ajuste.

Sub AtualizaRegistro()

  Dim rngFunc As Range, LR As Long

    Set rngFunc = Sheets("Funcionários").[A:A].Find(ActiveCell.Value)

      If Not rngFunc Is Nothing Then

        Sheets("Funcionários").Cells(rngFunc.Row, 1).Resize(, 9).Value = _

          Cells(ActiveCell.Row, 1).Resize(, 9).Value

      ElseIf MsgBox("Nome não encontrado." & vbLf & "Deseja criar novo registro?", vbYesNo) = vbYes Then

        With Sheets("Funcionários")

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

          .Cells(LR + 1, 1).Resize(, 9).Value = _

            Cells(ActiveCell.Row, 1).Resize(, 9).Value

        End With

      End If

End Sub

 

 

 

Cara aparentemente funcionou, só que percebi é que ela pega os dados da planilha cadastro em horizontal e os dados estão em vertical, assim:

 

capturarpb.png

E a Planilha funcionarios estão na horizontal assim

 

53248517.png

 

E tipo basicamente o que quero fazer é atualizar os dados do funcionário mantendo o mesmo registro que ele já tem tipo aonde esta Fernanda.. se quiser mudar a Função dela basta eu ir na planilha Cadastro,localizo a funcionária Fernanda altero o campo que quero no caso a função e clicar em atualiza... e ele joga os novos dados no mesmo registro já existente na planilha funcionários.. na mesma linha..

Editado por gabrielkakarotto

''

Compartilhar este post


Link para o post
Compartilhar em outros sites

Experimente este código.
Neste não é preciso selecionar a célula que contém o nome do funcionário, pois o código faz a busca com base no nome que está em 'C2'.


Sub AtualizaRegistro2()
  Dim rngFunc As Range, rngAt As Range
    Set rngFunc = Sheets("Funcionários").[A:A].Find([C2].Value)
      If Not rngFunc Is Nothing Then
      Set rngAt = Range("C2:C10")
        Sheets("Funcionários").Cells(rngFunc.Row, 1).Resize(, 9).Value = _
          Application.Transpose(rngAt)
      Else: MsgBox "Nome não encontrado."
      End If
End Sub



 


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites
Experimente este código.

Neste não é preciso selecionar a célula que contém o nome do funcionário, pois o código faz a busca com base no nome que está em 'C2'.

Sub AtualizaRegistro2()

  Dim rngFunc As Range, rngAt As Range

    Set rngFunc = Sheets("Funcionários").[A:A].Find([C2].Value)

      If Not rngFunc Is Nothing Then

      Set rngAt = Range("C2:C10")

        Sheets("Funcionários").Cells(rngFunc.Row, 1).Resize(, 9).Value = _

          Application.Transpose(rngAt)

      Else: MsgBox "Nome não encontrado."

      End If

End Sub

 

 

 

Cara MUITO OBRIGADO, tenho nem palavras pra te agradecer.. Um código curto, e funcional

 

Me matei pra tentar faz o que se fez sei lá em uns 10min? HUHUASUHAUHSHU !

 

Preciso de uma outra ajuda se não for pedir muito..

Tem como criar este mesmo código só que para deletar o cadastro?

Eu tentei usar uns comandos com esse código mas não deu certo :/

Compartilhar este post


Link para o post
Compartilhar em outros sites


Sub ExcluiRegistro()
  Dim rngFunc As Range
    Set rngFunc = Sheets("Funcionários").[A:A].Find([C2].Value)
      If Not rngFunc Is Nothing Then
        Sheets("Funcionários").Rows(rngFunc.Row).Delete
      Else: MsgBox "Nome não encontrado."
      End If
End Sub

 


 


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Sub ExcluiRegistro()

  Dim rngFunc As Range

    Set rngFunc = Sheets("Funcionários").[A:A].Find([C2].Value)

      If Not rngFunc Is Nothing Then

        Sheets("Funcionários").Rows(rngFunc.Row).Delete

      Else: MsgBox "Nome não encontrado."

      End If

End Sub

 

 

 

 

Obrigado mesmo cara, mas uma vez.. 

Agora a última dúvida HUAUHSHUASHUAUHSUH ! Eu prometo.

É que ultimamente venho usadomuito macro e comecei nisso agora.. para adicionar qualquer Caixa de mensagem uso

 

MsgBox "Texto Aqui"

 

Agora se eu quiser adicinar opção como SIM e NÃO ?

 

Tipo isso ElseIf MsgBox("Registro não encontrado" & vbLf & "Deseja criar novo registro?", vbYesNo) = vbYes Then

 

Tentei adicionar isso em outro código como no Excluindo, pra perguntar se tem certeza da exclusão, só que não funciona!

Compartilhar este post


Link para o post
Compartilhar em outros sites

Sub ExcluiRegistro2()
  Dim rngFunc As Range
    Set rngFunc = Sheets("Funcionários").[A:A].Find([C2].Value)
      If Not rngFunc Is Nothing Then
        If MsgBox("Confirma a exclusão de" & vbLf & rngFunc & " ?", vbYesNo) = vbYes Then
          Sheets("Funcionários").Rows(rngFunc.Row).Delete
        End If
      Else: MsgBox "Nome não encontrado."
      End If
End Sub

 


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Cara voltei a ter um problema com o Macro de Atualização 

 

Ele só esta atualizando uma parte dos campos..

 

vcbvcb.png

 

Só atualiza até I e vai até K os campos..  e outro problema mas isso é o de menos é que os campos de cadastro estão ficando na linha dois depois da coluna P..

Como posso atualizar este código para ele atualizar até  P

 

 

 

Sub AtualizaRegistro()
  Dim rngFunc As Range, rngAt As Range
    Set rngFunc = Sheets("Funcionários").[A:A].Find([C2].Value)
      If Not rngFunc Is Nothing Then
      Set rngAt = Range("C2:C10")
      End If
      If Not rngFunc Is Nothing Then
        If MsgBox("Confirma a atualização do cadastro de" & vbLf & rngFunc & " ?", vbYesNo) = vbYes Then
        Sheets("Funcionários").Cells(rngFunc.Row, 1).Resize(, 9).Value = _
        Application.Transpose(rngAt)
        End If
        Else: MsgBox "Nome não encontrado."
      MsgBox "> Atualizado com Sucesso!!!"
      
End If
End Sub
Editado por gabrielkakarotto

''

Compartilhar este post


Link para o post
Compartilhar em outros sites
Cara voltei a ter um problema com o Macro de Atualização 

 

Ele só esta atualizando uma parte dos campos..

 

vcbvcb.png

 

Só atualiza até I e vai até K os campos..  e outro problema mas isso é o de menos é que os campos de cadastro estão ficando na linha dois depois da coluna P..

Como posso atualizar este código para ele atualizar até  P

 

 

O código copia do intervalo 'C2:C10', portanto copia o conteúdo de 9 células, conforme está no seu código original e está também na figura que vc postou no post #3. Lembra disso?

Portanto ao colar as 9 células copiadas a partir da coluna 'A' a colagem chega até a coluna 'I', ou seja, 9 células. E lá atrás vc disse que estava feliz com o resultado.

 

Agora vc está mudando e quer que a colagem chegue até  'K', ou até 'P' ? Não ficou claro pra mim o que vc quer.

Se vc quer ampliar o intervalo de destino vc precisa dizer quais as células adicionais de origem que deseja copiar !

 

E também não entendi isto: e outro problema mas isso é o de menos é que os campos de cadastro estão ficando na linha dois depois da coluna P..


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites
O código copia do intervalo 'C2:C10', portanto copia o conteúdo de 9 células, conforme está no seu código original e está também na figura que você postou no post #3. Lembra disso?

Portanto ao colar as 9 células copiadas a partir da coluna 'A' a colagem chega até a coluna 'I', ou seja, 9 células. E lá atrás você disse que estava feliz com o resultado.

 

Agora você está mudando e quer que a colagem chegue até  'K', ou até 'P' ? Não ficou claro pra mim o que você quer.

Se você quer ampliar o intervalo de destino você precisa dizer quais as células adicionais de origem que deseja copiar !

 

E também não entendi isto: e outro problema mas isso é o de menos é que os campos de cadastro estão ficando na linha dois depois da coluna P..

 

 

Sim cara o seu código esta perfeito... sem erros...

É que depois eu adicionei mais campos.. o erro foi meu tô ligado.

E com base no que você me disse eu  consegui arrumar o Macro fazendo a colagem chegar a até P.

Ficando assim

 

 
Sub AtualizaRegistro()
  Dim rngFunc As Range, rngAt As Range
    Set rngFunc = Sheets("Funcionários").[A:A].Find([C2].Value)
      If Not rngFunc Is Nothing Then
      Set rngAt = Range("C2:C16")
      End If
      If Not rngFunc Is Nothing Then
        If MsgBox("Confirma a atualização do cadastro de" & vbLf & rngFunc & " ?", vbYesNo) = vbYes Then
        Sheets("Funcionários").Cells(rngFunc.Row, 1).Resize(, 16).Value = _
        Application.Transpose(rngAt)
        End If
        Else: MsgBox "Nome não encontrado."
      MsgBox "> Atualizado com Sucesso!!!"
      
End If
End Sub

 

E sobre o final, quis dizer isso

dsdsdsde.png

 

Que a colagem continua mesmo depois de P e isso vai até a célula XFD que é aonde acaba HUASHUAUHSH !

 

Acho que isso não é erro do seu Macro mas..

Compartilhar este post


Link para o post
Compartilhar em outros sites

Fiz uma faxina e um rearranjo nesse último código que vc postou. Para colar até 'P' é preciso copiar até 'C17'... Segue abaixo. Testaí...

E sobre o preenchimento extra que está ocorrendo além da coluna 'P', esse preenchimento não está sendo executado pelo código que vc postou. Vejo 2 possibilidades para esse preenchimento ocorrer:
1. existe algum código no módulo da planilha "Funcionários", do tipo Change ou Calculate que está efetuando o tal preenchimento, ou
2. uma entidade desconhecida se alojou no seu EXcel e tá te zoando...

Verifique primeiro no módulo da planilha. Se não houver nenhum código lá, então sugiro que vc leve seu Excel para uma sessão de descarrego...


Sub AtualizaRegistro()
  Dim rngFunc As Range, rngAt As Range
    Set rngFunc = Sheets("Funcionários").[A:A].Find([C2].Value)
      If Not rngFunc Is Nothing Then
        Set rngAt = Range("C2:C1
7")
          If MsgBox("Confirma a atualização do cadastro de" & vbLf & rngFunc & " ?", vbYesNo) = vbYes Then
            Sheets("Funcionários").Cells(rngFunc.Row, 1).Resize(, 16).Value = _
            Application.Transpose(rngAt)
            MsgBox "> Atualizado com Sucesso!!!"
          End If
      Else: MsgBox "Nome não encontrado."
      End If
End Sub



 


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

×