Ir ao conteúdo

Excel Macro procurar e copiar e colar


Ir à solução Resolvido por Visitante,

Posts recomendados

Postado

Boa tarde.

Preciso de ajuda para fazer uma macro no Excel. Já utilizei o forum vária vezes para tirar dúvidas e consegui encontrar todas usando a busca. Porém desta vez não consegui encontrar.

É o seguinte.

Tenho uma lista de contas contábeis em uma coluna de uma Plan "Balancete" na coluna A6 até .... (esse quantidade depende de empresa para empresa), ao lado desta Plan tenho varias outras que tem o mesmo nome desta lista e com as mesmas formatações de quantidade de colunas etc.

 

Preciso criar uma macro que leia a lista de contas na Plan "Balancete" e localize a respectiva Plan de nome igual e na sequencia, pegue e realizar uma função igual ao PROCV, ou seja, abra localize a conta XXX da Plan "Balancete" na célula A6, na célula C6 da Plan correspondente e traz o valor da célula F6. 

 

 

Desde já agradeço

 

Gilberto

 

  • Solução
Postado

Sugestão - disponibilize uma amostra do seu arquivo Excel, com 4 a 5 linhas com dados, com 3 ou 4 planilhas, com o resultado desejado e com as explicações na própria planilha Balancete de como obteve os resultados.

Postado

Olá, Gilberto.

Eu não consegui acessar o arquivo.

Anexe-o aqui no fórum, é mais fácil e mais simples para você e também para quem quiser baixar. Logo abaixo da caixa de resposta clique em "escolha os arquivos"

Postado

Gilberto, veja se o código abaixo atende.

O resultado será colocado na planilha Listar Abas como mostrado abaixo. O erro em C12 ocorre porque a planilha 63 não existe no arquivo.

Sub ReplicaDados()
 Dim LRd As Long, LRo As Long, c As Range
  Application.ScreenUpdating = False
  On Error Resume Next
  Sheets("BALANCETE_2018").ShowAllData

   If Sheets("Listar Abas").[A6] <> "" Then Sheets("Listar Abas") _
   .Range("A6:C" & Sheets("Listar Abas").Cells(Rows.Count, 1).End(3).Row).Value = ""
   
  With Sheets("BALANCETE_2018")
   LRo = .Cells(Rows.Count, 1).End(3).Row
   .[A5].AutoFilter 2, ""
   .[A5].AutoFilter 3, "<>1.1.02.001.001*"
   .Range("A6:A" & LRo).SpecialCells(12).Copy Sheets("Listar Abas").[A6]
   .Range("C6:C" & LRo).SpecialCells(12).Copy Sheets("Listar Abas").[B6]
   On Error Resume Next
   .ShowAllData
  End With

  With Sheets("Listar Abas")
   LRd = .Cells(Rows.Count, 1).End(3).Row
   .Range("C6:C" & LRd).Formula = "=INDIRECT(A6&""!F4"")"
   .Range("C6:C" & LRd).Value = .Range("C6:C" & LRd).Value
  End With
  Application.ScreenUpdating = True
End Sub

 

 

obs. verifique a planilha BALANCETE_2018 pois há dados visíveis somente no intervalo A5:G23 no entanto ela está acusando que o intervalo em uso é A:H, ou seja, as colunas inteiras, talvez alguma formatação ou sujeira invisível, e isso poderá provocar aumento no tamanho do arquivo e lentidão para abrir, fechar, salvar, recalcular. Seria conveniente copiar os dados para uma planilha vazia e excluir a atual.

 

Resultado

image.png.d9bfdef93761abc5b1061f59cf4b7fbf.png

 

 

Postado

Osvaldo,

 

tentei rodar o código, porém resulta em erro...

image.png.1808d74b3c18a9b192166bfdbb195267.png

 

Quanto ao modelo de resultado que você apresentou, ficou um pouco diferente ao que estava esperando, veja o modelo do resultado final esperado.

 

image.thumb.png.b2258227d818b86042eeb0ea70fb7195.png

 

 

 

 

 

Postado
Em 09/09/2018 às 20:04, Gilberto_Silva disse:

tentei rodar o código, porém resulta em erro

 

Editei o post #6 e coloquei Tags no código, veja se ainda ocorre o erro.

 

 

 

Postado

Osvaldo,

 

obrigado pelo retorno, acho que não me expliquei bem.

 

Seria possível, apenas copiar os nomes das planilhas para a coluna C linha 6 na planilha "Listar Abas"? e na copiar os valores das células F4 destas mesmas planilhas para a coluna D linha 6?

 

image.png.1d98c373d3b5f2a820d3dac359154d70.png 

Postado
5 horas atrás, Gilberto_Silva disse:

Seria possível, apenas copiar os nomes das planilhas para a coluna C linha 6 na planilha "Listar Abas"? e na copiar os valores das células F4 destas mesmas planilhas para a coluna D linha 6?

O código abaixo colocará o resultado nas colunas B:C, conforme a imagem abaixo que você disponibilizou, que está diferente da sua descrição acima. E o resultado do código será diferente do resultado da imagem pois o da imagem não atende aos critérios que você próprio informou.

image.png.1d98c373d3b5f2a820d3dac359154d70.png 


 

Sub ReplicaDadosV2()
 Dim LRd As Long, LRo As Long, c As Range
  Application.ScreenUpdating = False
  On Error Resume Next
  Sheets("BALANCETE_2018").ShowAllData

   If Sheets("Listar Abas").[B6] <> "" Then Sheets("Listar Abas") _
   .Range("B6:C" & Sheets("Listar Abas").Cells(Rows.Count, 2).End(3).Row).Value = ""
   
  With Sheets("BALANCETE_2018")
   LRo = .Cells(Rows.Count, 1).End(3).Row
   .[A5].AutoFilter 2, ""
   .[A5].AutoFilter 3, "<>1.1.02.001.001*"
   .Range("A6:A" & LRo).SpecialCells(12).Copy Sheets("Listar Abas").[B6]
   On Error Resume Next
   .ShowAllData
  End With

  With Sheets("Listar Abas")
   LRd = .Cells(Rows.Count, 2).End(3).Row
   .Range("C6:C" & LRd).Formula = "=INDIRECT(B6&""!F4"")"
   .Range("C6:C" & LRd).Value = .Range("C6:C" & LRd).Value
  End With
  Application.ScreenUpdating = True
End Sub

 

Postado
Em 17/09/2018 às 00:40, osvaldomp disse:

.

Osvaldo, obrigado pelo retorno.

 

para simplificarmos, o código poderia ser modificado para fazer a minha citação?

 

mais uma vez obrigado

 

Postado

Desculpe pela insistência, mas seria possível, apenas copiar os nomes das planilhas para a coluna C linha 6 na planilha "Listar Abas"? e depois copiar os valores das células F4 destas mesmas planilhas para a coluna D linha 6 da mesma planilha "Listar Abas"?

 

muito obrigado.

Postado

Segue abaixo o código com as alterações.

Somente na primeira vez antes de rodar o código, faça as seguintes alterações na planilha Listar Abas :
1. reexiba as linhas ocultas
2. limpe as colunas C:D a partir da linha 6
3. desfaça as mesclagens de células da coluna D

 

Sub ReplicaDadosV3()
 Dim LRd As Long, LRo As Long, c As Range
  Application.ScreenUpdating = False
  If Sheets("Listar Abas").[C6] <> "" Then Sheets("Listar Abas") _
   .Range("C6:D" & Sheets("Listar Abas").Cells(Rows.Count, 3).End(3).Row).Value = ""
  With Sheets("BALANCETE_2018")
   On Error Resume Next
   .ShowAllData
   On Error GoTo 0
   LRo = .Cells(Rows.Count, 1).End(3).Row
   .[A5].AutoFilter 2, ""
   .[A5].AutoFilter 3, "<>1.1.02.001.001*"
   .Range("A6:A" & LRo).SpecialCells(12).Copy Sheets("Listar Abas").[C6]
   On Error Resume Next
   .ShowAllData
   On Error GoTo 0
  End With
  With Sheets("Listar Abas")
   LRd = .Cells(Rows.Count, 3).End(3).Row
   .Range("D6:D" & LRd).Formula = "=INDIRECT(C6&""!F4"")"
   .Range("D6:D" & LRd).Value = .Range("D6:D" & LRd).Value
  End With
  Application.ScreenUpdating = True
End Sub

 

  • 3 semanas depois...
Postado
Em 27/09/2018 às 16:16, osvaldomp disse:

Segue abaixo o código com as alterações.

Somente na primeira vez antes de rodar o código, faça as seguintes alterações na planilha Listar Abas :
1. reexiba as linhas ocultas
2. limpe as colunas C:D a partir da linha 6
3. desfaça as mesclagens de células da coluna D

 


Sub ReplicaDadosV3()
 Dim LRd As Long, LRo As Long, c As Range
  Application.ScreenUpdating = False
  If Sheets("Listar Abas").[C6] <> "" Then Sheets("Listar Abas") _
   .Range("C6:D" & Sheets("Listar Abas").Cells(Rows.Count, 3).End(3).Row).Value = ""
  With Sheets("BALANCETE_2018")
   On Error Resume Next
   .ShowAllData
   On Error GoTo 0
   LRo = .Cells(Rows.Count, 1).End(3).Row
   .[A5].AutoFilter 2, ""
   .[A5].AutoFilter 3, "<>1.1.02.001.001*"
   .Range("A6:A" & LRo).SpecialCells(12).Copy Sheets("Listar Abas").[C6]
   On Error Resume Next
   .ShowAllData
   On Error GoTo 0
  End With
  With Sheets("Listar Abas")
   LRd = .Cells(Rows.Count, 3).End(3).Row
   .Range("D6:D" & LRd).Formula = "=INDIRECT(C6&""!F4"")"
   .Range("D6:D" & LRd).Value = .Range("D6:D" & LRd).Value
  End With
  Application.ScreenUpdating = True
End Sub

 

Bom dia Osvaldo,

 

Minha planilha está evoluindo, desde já agradeço e muito sua ajuda!

 

Não sei se é possível, mais vou perguntar: É possível criar um código para inserir hyperlink em uma lista com as planilhas do mesmo arquivo?

 

Tenho a Plan "Listar_Abas" e gostaria de inserir um link para quando clicar em um nome de  "Listar_abas" já direto a planilha desejada.

 

Encontrei um código que você havia criado para um outro participante deste forum, em partes ele atende, porém não será necessário criar as novas planilhas, apenas criar o link dos nomes das já existentes para uma listas como o nomes destas planilhas.

 

veja o código que encontrei:

 

Sub CriaNomeiaHyper() Dim planBase, planNova As String Dim plan As Worksheet, flg As Boolean planBase = ActiveSheet.Name planNova = ActiveSheet.Range("A1").Value If planNova = "" Then MsgBox "insira em A1 o nome desejado para a nova planilha" Exit Sub End If For Each plan In Worksheets If plan.Name Like planNova Then flg = True: Exit For Next If flg = True Then MsgBox "já existe a planilha " & "'" & _ planNova & "'" & ", altere o nome desejado" Else Worksheets.Add(after:=Sheets(Sheets.Count)).Name = planNova ActiveSheet.Hyperlinks.Add Anchor:= _ Sheets(planBase).Range("A1"), Address:="", _ SubAddress:="'" & ActiveSheet.Name _ & "'!A1", TextToDisplay:=ActiveSheet.Name End If End Sub

 

 

Desde já agradeço.

 

Att.

 

Gilberto

 

 

 

Postado

Selecione a planilha Listar Abas e rode o código abaixo. Resultado na coluna A, altere no código se quiser.

Nos casos de inclusão/exclusão ou alteração de nomes de planilhas rode o código para exibir a lista atualizada.

 

Sub ListaPlansHiperlinks()
 Dim ws As Worksheet
  [A:A] = ""
   For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Listar Abas" Then
     Cells(Rows.Count, "A").End(3)(2) = ws.Name
     ActiveSheet.Hyperlinks.Add Anchor:=Cells(Rows.Count, 1).End(3), Address:="", SubAddress:= _
      "'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
    End If
   Next ws
End Sub

 

Postado
14 horas atrás, osvaldomp disse:

Selecione a planilha Listar Abas e rode o código abaixo. Resultado na coluna A, altere no código se quiser.

Nos casos de inclusão/exclusão ou alteração de nomes de planilhas rode o código para exibir a lista atualizada.

 


Sub ListaPlansHiperlinks()
 Dim ws As Worksheet
  [A:A] = ""
   For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Listar Abas" Then
     Cells(Rows.Count, "A").End(3)(2) = ws.Name
     ActiveSheet.Hyperlinks.Add Anchor:=Cells(Rows.Count, 1).End(3), Address:="", SubAddress:= _
      "'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
    End If
   Next ws
End Sub

 

Osvaldo,

o código está apagando minha lista da coluna A e inserindo a informação Plan1 e Plan1(2) com hyperlink, porém essas Plan1 não existe em meu arquivo.

 

Por exemplo: Tenho na coluna A da planilha "Listar Abas" uma sequencia numerica que são os nomes das planilhas laterais, o código tem que comparar minha lista com essas planilhas existentes e inserir o hyperlink quando existir uma coincidência entre a lista e as plans existentes.

 

Desde já agradeço

 

Gilberto

 

 

Postado
40 minutos atrás, Gilberto_Silva disse:

o código está apagando minha lista da coluna A e inserindo a informação Plan1 e Plan1(2) com hyperlink,

Eu entendi que você quer uma lista com os nomes das planilhas e os correspondentes Hiperlinks e como você não informou  em qual coluna você quer a lista eu optei pela coluna A.

 

porém essas Plan1 não existe em meu arquivo.

Essa eu gostaria de ver, pois a probabilidade de o código colocar na lista o nome de uma planilha inexistente é equivalente a encontrar um político honesto, ou seja, zero! :rolleyes:

 

Por exemplo: Tenho na coluna A da planilha "Listar Abas" uma sequencia numerica que são os nomes das planilhas laterais, o código tem que comparar minha lista com essas planilhas existentes e inserir o hyperlink quando existir uma coincidência entre a lista e as plans existentes.

Disponibilize uma amostra do seu arquivo Excel com o resultado desejado.

 

 

dica - para responder clique em Responder, localizado abaixo da última postagem. Só clique em Citar se necessário.

Postado

Osvaldo, boa tarde.

 

o código está apagando minha lista da coluna A e inserindo a informação Plan1 e Plan1(2) com hyperlink,

Eu entendi que você quer uma lista com os nomes das planilhas e os correspondentes Hiperlinks e como você não informou  em qual coluna você quer a lista eu optei pela coluna A.

Anexei uma amostra da planilha, na planilha Balancete_2018 coluna A (linha 6 em diante) tenho a relação das contas contábeis , que possuem planilhas no mesmo arquivo com os mesmos nomes.

Já na coluna J de Balancete_2018, tenho informações, se a conta é sintética, se está conciliada ou não conciliada..... O que preciso é que o hiperlink seja criado na coluna J de Balancete_2018, quando existir uma planilha aberta com o mesmo nome.

 

porém essas Plan1 não existe em meu arquivo.

Essa eu gostaria de ver, pois a probabilidade de o código colocar na lista o nome de uma planilha inexistente é equivalente a encontrar um político honesto, ou seja, zero! 

 

Por exemplo: Tenho na coluna A da planilha "Listar Abas" uma sequencia numerica que são os nomes das planilhas laterais, o código tem que comparar minha lista com essas planilhas existentes e inserir o hyperlink quando existir uma coincidência entre a lista e as plans existentes.

Disponibilize uma amostra do seu arquivo Excel com o resultado desejado.

Anexei uma amostra da planilha

 

Osvaldo, mais uma vez agradeço sua paciência em me ajudar.

 

Att

 

Gilberto

 

 

2 horas atrás, osvaldomp disse:

 

dica - para responder clique em Responder, localizado abaixo da última postagem. Só clique em Citar se necessário.

(AMOSTRA) CONCILIAÇÕES_SET_2018.rar

Postado

Olá, Gilberto.

Veja se é isso. O código abaixo insere Hiperlink na coluna J para a planilha com o nome na coluna A.
 

Sub InsereHiperlinks()
 Dim c As Range
  With Range("J6:J" & Cells(Rows.Count, 1).End(3).Row)
   .ClearHyperlinks
   .Font.Underline = xlUnderlineStyleNone
  End With
  For Each c In Range("A6:A" & Cells(Rows.Count, 1).End(3).Row)
   If Evaluate("ISREF('" & (c.Value) & "'!A1)") = True Then
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(c.Row, "J"), Address:="", SubAddress:= _
        "'" & c.Value & "'!A1"
   End If
  Next c
End Sub

 

Postado
Em 17/10/2018 às 21:44, osvaldomp disse:

Olá, Gilberto.

Veja se é isso. O código abaixo insere Hiperlink na coluna J para a planilha com o nome na coluna A.
 


Sub InsereHiperlinks()
 Dim c As Range
  With Range("J6:J" & Cells(Rows.Count, 1).End(3).Row)
   .ClearHyperlinks
   .Font.Underline = xlUnderlineStyleNone
  End With
  For Each c In Range("A6:A" & Cells(Rows.Count, 1).End(3).Row)
   If Evaluate("ISREF('" & (c.Value) & "'!A1)") = True Then
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(c.Row, "J"), Address:="", SubAddress:= _
        "'" & c.Value & "'!A1"
   End If
  Next c
End Sub

 

Osvaldo, boa tarde!

 

Ainda no projeto da minha planilha de conciliação contábil, tenho outra situação: de um mês para outro, podem surgir novas contas no Balancete_2018, para isso, tenho uma formula na coluna J do balancete que indica "INSERIR CONTA NA PASTA DA CONCILIAÇÃO". Pergunto: É possível fazer a leitura desta frase na coluna J e através de uma planilha Modelo, criar uma planilha e renomear e inserir as informações, como numero da conta e descrição da conta?

 

Mais uma vez de agradeço imensamente pela sua ajuda até aqui.

 

PS. Seria possível compilar dois códigos em apenas um?

 

 

 

 

Att.

 

Gilberto

 

Postado
Em 22/10/2018 às 16:20, Gilberto_Silva disse:

Osvaldo, boa tarde!

 

Ainda no projeto da minha planilha de conciliação contábil, tenho outra situação: de um mês para outro, podem surgir novas contas no Balancete_2018, para isso, tenho uma formula na coluna J do balancete que indica "INSERIR CONTA NA PASTA DA CONCILIAÇÃO". Pergunto: É possível fazer a leitura desta frase na coluna J e através de uma planilha Modelo, criar uma planilha e renomear e inserir as informações, como numero da conta e descrição da conta?

 

Mais uma vez de agradeço imensamente pela sua ajuda até aqui.

 

PS. Seria possível compilar dois códigos em apenas um?

 

 

 

 

Att.

 

Gilberto

 

Olá Osvaldo, 

 

Seria possível o citado acima? 

Postado
Em 22/10/2018 às 17:20, Gilberto_Silva disse:

Ainda no projeto da minha planilha de conciliação contábil, tenho outra situação: ..

 

Gilberto, você sequer informou se a segunda demanda que você colocou neste tópico foi resolvida e já colocou a terceira demanda (citação acima). Eu já tô perdido aqui, pois este tópico está com mais de 20 postagens e sem perspectiva de conclusão.

Sugestão: encerre este tópico e abra outro, anexe o seu arquivo com os códigos que você já tem e que funcionam a contento e explique com exatidão sobre essa terceira demanda.

Postado
6 horas atrás, osvaldomp disse:

 

Gilberto, você sequer informou se a segunda demanda que você colocou neste tópico foi resolvida e já colocou a terceira demanda (citação acima). Eu já tô perdido aqui, pois este tópico está com mais de 20 postagens e sem perspectiva de conclusão.

Sugestão: encerre este tópico e abra outro, anexe o seu arquivo com os códigos que você já tem e que funcionam a contento e explique com exatidão sobre essa terceira demanda.

Por gentileza sou novo no fórum não estou localizando a forma de encerrar.  Vou publicar os códigos que funcionaram, você está de parabéns, Deus lhe abençoe e muito obrigado. 

 

Att

 

Gilberto 

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

LANÇAMENTO!

eletronica2025-popup.jpg


CLIQUE AQUI E BAIXE AGORA MESMO!