Replicar dados das planilhas em uma planilha

[David.sps]

Olá a todos,

 possuo uma pasta de trabalho com aproximadamente umas 40 abas com nome dos setores cada uma (elas tem o layout padrão), possuo uma VBA que me lista o nome de todas as abas (com atualização automática)(como hiperlink - posso tirar o hiperlink), gostaria de fazer um resumo de todos os dados das abas dos setores em uma só aba....

os dados nas abas ficarão de A10:F150 sendo a linha 10 o cabeçalho padrão. Novamente digo gostaria de ter o controle em uma planilha de resumo para controlar o vencimento de todos os documentos assim como todas as outras informações....

SE alguém souber uma vba (detalhada) que eu consiga linkar na lista de abas que eu quero que copie os dados seria excelente.

 

Desde já agradeço e conto com a ajuda de todos = D

[Visitante]

Olá, David.

Se entendi corretamente, você deseja replicar os dados de todas as planilhas em uma planilha "resumo". Ou você quer escolher na lista quais planilhas serão replicadas?

 

O intervalo replicado será sempre A11:F150 para todas as planilhas?  Poderá variar em linhas e ou colunas?

 

A os dados serão replicados em sequência na planilha "resumo" ? Deseja deixar linhas vazias entre os dados de cada planilha? Deseja colocar o nome de cada planilha na linha que antecederá seus dados?

 

O que você quer dizer com "uma vba (detalhada)" ?

[David.sps]

Olá Osvaldo,

gostaria de replicar todas as informações como estão e sem variação do layout (linha coluna) serão os intervalos citados.

Com relação as abas a serem copiadas, é que possuo uma plan modelo, a plan resumo e mais uma, poderia ser  a partir da 3 até o final...

Na plan resumo eu iria utilizar filtro, e classificação de acordo com a ocasião (ex: data, setor etc)....

O nome da planilha é interessante, seria ótimo, porém se for muito trabalhoso é indiferente, pois o nome dos arquivos contém o nome dos setores que por sua vez são os nomes das abas.

 

VBA detalhada me referia a vba com a explicação na própria vba (ex: esse é o intervalo para cópia de dados...)

 

Grato

[Visitante]

1. considerei que no seu arquivo já existe uma planilha de nome "resumo" (sem as aspas) devidamente formatada para receber os dados
2. considerei que as planilhas "BANCO DE DADOS", "Modelo" e "Plan1" não serão replicadas, altere se necessário
3. considerei que você sabe onde instalar e como rodar o código
4. se o código não funcionar ou se não apresentar o resultado desejado, disponibilize uma amostra do seu arquivo com as explicações dos problemas encontrados (não testei pois você não disponibilizou o arquivo)
5. após finalizar o código (funcionar a contento) colocarei os comentários
 

Sub ReplicaDados() Dim ws As Worksheet, LR As Long  Sheets("resumo").Range("A2", Range("F2").End(xlDown)).ClearContents   For Each ws In Worksheets    If ws.Name <> "resumo" And ws.Name <> "BANCO DE DADOS" And ws.Name <> "Modelo" And _     ws.Name <> "Plan1" Then     With Sheets("resumo")      LR = .Cells(Rows.Count, 1).End(xlUp).Row      .Cells(LR + 1, 1) = ws.Name      .Cells(LR + 2, 1).Resize(140, 6).Value = ws.Range("A11:F150").Value     End With    End If   Next wsEnd Sub

[David.sps]

Osvaaaaaaaaaaaaaldo!

 

Está excelente, entretanto EU atribui a um botão, pois não consegui deixar para ativar quando selecionar a planlinha "resumo", o problema nem é isso, é que não está atualizando nem quando executo a macro novamente... Ao executar novamente a macro apaga todos os dados copiado e não cola novamente, nem mesmo executando duas vezes.

 

 

*A VBA está copiando apenas 1 dado errado, puxa "adm" e coloca pendente (validação) , e não descobri o porque... de resto está excelente e está sinalizando a aba etc....

http://imageshack.com/a/img537/3213/Ib33Iv.png

http://imageshack.com/a/img908/5302/FcfNF0.png

Gostaria que me ajudasse nesta parte, para execução e atualização automática sempre que eu selecionar a plan "MODELO"

 

 

OBRIGADO!

[Visitante]

... pois não consegui deixar para ativar quando selecionar a planlinha "resumo",...

... para execução e atualização automática sempre que eu selecionar a plan "MODELO"

 

Você quer rodar o código ao selecionar a planilha "resumo" ou a "MODELO"? Ou qualquer das duas?

 

 

 

 

 

4. se o código não funcionar ou se não apresentar o resultado desejado, disponibilize uma amostra do seu arquivo com as explicações dos problemas encontrados (não testei pois você não disponibilizou o arquivo)

 

Aguardo o seu arquivo para prosseguir, pois você voltou a colocar imagens de uma planilha. Não serve. Disponibilize o arquivo (Pasta de Trabalho) com o código instalado.

[David.sps]

 

 

 

 

Prezado Osvaldo, 

a atualização apenas quando abrir a plan "resumo" é suficiente.

Estou mandando o arquivo para da uma olhada e o erro que encontrei é o da figura 3 e 4 que também estou enviando.

 

*ps nem todas as abas estão ainda no formato padrão estou fazendo isso aos poucos (apenas informando).

 

Grato.

Desktop.rar

[David.sps]

Segue a mesma planilha, porém havia feito cópia e não deixei a plan resumo editada....

Desculpe.

TESTANDO DOCUMENTOS A SEREM VALIDADOS.rar

[Visitante]

Fala, David.
Faça os testes com o código abaixo. Já está com as alterações para corrigir as divergências entre as informações iniciais que você passou e o arquivo que você postou no post #8.

obs.
Antes de rodar o código:
1.existem "sujeiras invisíveis" na planilha "RESUMO", linha 496, e na planilha "SPI", linha 9. Sugiro que você exclua as duas e as refaça a partir de planilhas em branco.
2.em algumas planilhas o cabeçalho não está na linha 10. Corrija.
 

Sub ReplicaDados() Dim ws As Worksheet, LRo As Long, LRd As Long  LRd = Sheets("RESUMO").UsedRange.Rows.Count: If LRd = 10 Then LRd = 11  Sheets("resumo").Range("A11:F" & LRd).ClearContents   For Each ws In Worksheets    If ws.Name <> "RESUMO" And ws.Name <> "BANCO DE DADOS" And ws.Name <> "MODELO" And _     ws.Name <> "Plan1" Then     With Sheets("RESUMO")      LRd = .UsedRange.Rows.Count      .Cells(LRd + 1, 1) = ws.Name      LRo = ws.UsedRange.Rows.Count      .Cells(LRd + 2, 1).Resize(LRo - 10, 6).Value = ws.Range("A11:F" & LRo).Value     End With    End If   Next wsEnd Sub

Instale o código abaixo no módulo da planilha "RESUMO"

Private Sub Worksheet_Activate() ReplicaDadosEnd Sub

[David.sps]

Caro Osvaldo,

agradeço a enorme atenção e rapidez nas respostas.

Informo que não obtive sucesso com o código....

Testei colocando o primeiro código (replicadados) em "estapastadetrabalho" e nada é copiado ao realizar a execução (apertando o "play"), coloquei o outro código na aba resumo e aparece a mensagem erro de compilação sub ou function não definida....

Creio que eu não esteja sabendo inserir =s.

 

Caso se possível e caso seja mais prático insira o código no arquivoque estou lhe enviando que eu vejo como está e copio no original.

*Há uma aba (CCIH) que não está no formato padrão, entretanto erá será excluída posteriormente e por isso não mexi.

 

Mais uma vez agradeço a enooooooooorme paciência.

 

Que tenha um ótimo ano │ Deus está contigo.

TESTANDO DOCUMENTOS A SEREM VALIDADOS.rar

[Visitante]

Olá, David.

Instale o código "ReplicaDados" em um módulo comum, assim:
      1. copie o código daqui
      2. a partir de qualquer planilha tecle 'Alt+F11' para acessar o

          editor de VBA
      3. no menu do editor >> Inserir >> Módulo
      4. cole o código na janela em branco que vai se abrir (cole no

          módulo comum recém inserido, não cole no módulo de

         "EstaPasta_de_trabalho")
      5. feito! 'Alt+Q' para retornar para a planilha e testar

para rodar o código:
6. tecle 'Alt+F8' >> selecione a macro correspondente >> Executar, ou insira um botão na planilha e vincule-o à macro ou vincule-a a um atalho de teclado (Alt+F8 > Opções).


Instale o código "Private Sub Worksheet_Activate" no módulo da planilha "RESUMO", assim:
      1. copie o código daqui
      2. clique com o direito na guia da planilha "RESUMO" 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

funcionamento - o código "ReplicaDados" irá rodar a cada vez que a planilha "RESUMO" for ativada, como você pediu. Além disso, você poderá rodar esse código sempre que quiser, independente da planilha que estiver ativa, conforme comentado acima ("para rodar o código:").

 

Ótimo Ano Novo pra você também. Saúde e paz.

 

PS - testei o código no arquivo do post #10. Os dados que deveriam ser lançados na planilha "RESUMO" a partir da linha 2, pois essa é a primeira linha vazia (ao menos é o que se vê), são lançados a partir da linha 505. Isso ocorre porque o código lê que na linha 504 existe célula com conteúdo. São as "sujeiras invisíveis" que comentei antes.

[David.sps]

Caro Osvaldo,

novamente lhe agradeço pela prestatividade.

O código está show, entretanto continua copiando e jogando lá para baixo da planilha (e cada vez que executo a macro ela joga ainda mais para baixo) já consigo fazer o que quero  apagando as linhas que ficam antes da colagem.... me facilitou em muito! 

Caso seja algo "fácil", poderia me indicar algum post o tutorial que eu consiga ver essas "sujeiras invisíveis"?

[Visitante]

Fala, David.

Agora vai!

Eu testei outros comandos que buscam a ultima linha com conteúdo e este que coloquei no código parece que ignora a "sujeira". Faça os testes com o código abaixo que está alterado.

Sub ReplicaDados() Dim ws As Worksheet, LRo As Long, LRd As Long  LRd = Columns("A:F").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row  If LRd = 10 Then LRd = 11  Sheets("RESUMO").Range("A11:F" & LRd).ClearContents   For Each ws In Worksheets    If ws.Name <> "RESUMO" And ws.Name <> "BANCO DE DADOS" And ws.Name <> "MODELO" And _     ws.Name <> "Plan1" Then     With Sheets("RESUMO")      LRd = Columns("A:F").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row      .Cells(LRd + 1, 1) = ws.Name      LRo = ws.Columns("A:F").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row      If LRo = 10 Then LRo = 11      .Cells(LRd + 2, 1).Resize(LRo - 10, 6).Value = ws.Range("A11:F" & LRo).Value     End With    End If   Next wsEnd Sub

[David.sps]

Osvaldo,

o código que estava ótimo, agora está extremamente eficiente e eficaz, está excelente!

* está de fácil entendimento também.

 

Agradeço imensamente a atenção e paciência.

Muito obrigado! 

 

 

Salmos 55:22 - Confia os teus cuidados ao Senhor, e ele te susterá; jamais permitirá que o justo seja abalado.

[Visitante]

Fala, David.

Ficamos contentes por você ter resolvido a sua questão , enquanto agradecemos pela oportunidade que nos deu para aprendermos mais um pouco .

[Patropi]

David

 

Só faltou clicar no botão Curtir das excelentes respostas do Osvaldo.

 

[]s