Logo Hardware.com.br
viniciussn
viniciussn Novo Membro Registrado
13 Mensagens 1 Curtida

[Resolvido] Copiar dados de várias pastas de trabalhos diferentes.

#1 Por viniciussn 10/08/2018 - 14:01
Boa tarde pessoal!

Gostaria de uma ajuda se possível, pois eu não entendo muito bem de VBA.

Estou querendo criar um código onde eu tenho uma planilha "Resumo dos Ensaios" em uma pasta de trabalho. E também possuo várias outras pastas de trabalho onde servirão de origem para os dados a serem copiados para a planilha resumo dos ensaios (destino). Eu já até conseguir fazer funcionar com um código que achei na internet e fui alterando. Porém esta planilha "Resumo dos Ensaios" possui em média 22 colunas que deveriam ser preenchidas por outras 22 pastas de trabalho diferentes. Do jeito que eu fiz até agora, está funcionando para 3 colunas, ou seja para 3 pastas de trabalho. Eu consigo fazer para todas as 22, porém do jeito que estou fazendo o código vai ficar enorme. Eu queria fazer um código mais simples, onde ele automaticamente entendesse que caso exista as planilhas 001, 002, 003, 004... (e por aí vai...) dentro de uma pasta específica, as colunas sejam preenchidas com os dados corretos. E caso não exista todas as 22 dentro da pasta, ele só preenche a mesma quantidade de colunas de planilhas existentes. Não sei se conseguir explicar direito. Mas vou enviar o código e a planilha em anexo para vocês tentarem me entender e me ajudar da melhor forma possível. Desde já agradeço a todos!

Sub IMPORTAÇÃO()



       Application.ScreenUpdating = False

      

       Dim wsOrigem As Worksheet

       Dim wsDestino As Worksheet

      

       Workbooks.Open Filename:="C:\Users\Vinicius.Nascimento\Desktop\TESTE\001.xlsx"

       

       Set wsOrigem = Workbooks("001.xlsx&quot.Worksheets("RESUMO&quot

       Set wsDestino = Workbooks("RESUMO DOS ENSAIOS.xlsm&quot.Worksheets("RESUMO&quot

         

           wsDestino.Range("E7&quot.Value = wsOrigem.Range("F10&quot.Value

           wsDestino.Range("E8&quot.Value = wsOrigem.Range("F11&quot.Value

           wsDestino.Range("E9&quot.Value = wsOrigem.Range("F12&quot.Value

           wsDestino.Range("E10&quot.Value = wsOrigem.Range("F13&quot.Value

           wsDestino.Range("E11&quot.Value = wsOrigem.Range("F33&quot.Value

           wsDestino.Range("E12&quot.Value = wsOrigem.Range("F16&quot.Value

           wsDestino.Range("E13&quot.Value = wsOrigem.Range("F17&quot.Value

           wsDestino.Range("E14&quot.Value = wsOrigem.Range("F18&quot.Value

           wsDestino.Range("E15&quot.Value = wsOrigem.Range("F19&quot.Value

           wsDestino.Range("E16&quot.Value = wsOrigem.Range("F20&quot.Value

           wsDestino.Range("E17&quot.Value = wsOrigem.Range("F21&quot.Value

           wsDestino.Range("E18&quot.Value = wsOrigem.Range("F22&quot.Value

           wsDestino.Range("E19&quot.Value = wsOrigem.Range("F23&quot.Value

           wsDestino.Range("E20&quot.Value = wsOrigem.Range("F24&quot.Value

           wsDestino.Range("E21&quot.Value = wsOrigem.Range("F25&quot.Value

           wsDestino.Range("E22&quot.Value = wsOrigem.Range("F26&quot.Value

           wsDestino.Range("E23&quot.Value = wsOrigem.Range("F27&quot.Value

           wsDestino.Range("E24&quot.Value = wsOrigem.Range("F28&quot.Value

           wsDestino.Range("E25&quot.Value = wsOrigem.Range("F29&quot.Value

           wsDestino.Range("E26&quot.Value = wsOrigem.Range("F34&quot.Value

           wsDestino.Range("E27&quot.Value = wsOrigem.Range("F35&quot.Value

           wsDestino.Range("E31&quot.Value = wsOrigem.Range("F31&quot.Value

           wsDestino.Range("E32&quot.Value = wsOrigem.Range("F37&quot.Value

           wsDestino.Range("E33&quot.Value = wsOrigem.Range("F36&quot.Value

           wsDestino.Range("E34&quot.Value = wsOrigem.Range("F32&quot.Value

          

       Workbooks("001.xlsx&quot.Close SaveChanges:=True

      

       Workbooks.Open Filename:="C:\Users\Vinicius.Nascimento\Desktop\TESTE\002.xlsx"

          

       Set wsOrigem = Workbooks("002.xlsx&quot.Worksheets("RESUMO&quot

       Set wsDestino = Workbooks("RESUMO DOS ENSAIOS.xlsm&quot.Worksheets("RESUMO&quot

         

           wsDestino.Range("F7&quot.Value = wsOrigem.Range("F10&quot.Value

           wsDestino.Range("F8&quot.Value = wsOrigem.Range("F11&quot.Value

           wsDestino.Range("F9&quot.Value = wsOrigem.Range("F12&quot.Value

           wsDestino.Range("F10&quot.Value = wsOrigem.Range("F13&quot.Value

           wsDestino.Range("F11&quot.Value = wsOrigem.Range("F33&quot.Value

           wsDestino.Range("F12&quot.Value = wsOrigem.Range("F16&quot.Value

           wsDestino.Range("F13&quot.Value = wsOrigem.Range("F17&quot.Value

           wsDestino.Range("F14&quot.Value = wsOrigem.Range("F18&quot.Value

           wsDestino.Range("F15&quot.Value = wsOrigem.Range("F19&quot.Value

           wsDestino.Range("F16&quot.Value = wsOrigem.Range("F20&quot.Value

           wsDestino.Range("F17&quot.Value = wsOrigem.Range("F21&quot.Value

           wsDestino.Range("F18&quot.Value = wsOrigem.Range("F22&quot.Value

           wsDestino.Range("F19&quot.Value = wsOrigem.Range("F23&quot.Value

           wsDestino.Range("F20&quot.Value = wsOrigem.Range("F24&quot.Value

           wsDestino.Range("F21&quot.Value = wsOrigem.Range("F25&quot.Value

           wsDestino.Range("F22&quot.Value = wsOrigem.Range("F26&quot.Value

           wsDestino.Range("F23&quot.Value = wsOrigem.Range("F27&quot.Value

           wsDestino.Range("F24&quot.Value = wsOrigem.Range("F28&quot.Value

           wsDestino.Range("F25&quot.Value = wsOrigem.Range("F29&quot.Value

           wsDestino.Range("F26&quot.Value = wsOrigem.Range("F34&quot.Value

           wsDestino.Range("F27&quot.Value = wsOrigem.Range("F35&quot.Value

           wsDestino.Range("F31&quot.Value = wsOrigem.Range("F31&quot.Value

           wsDestino.Range("F32&quot.Value = wsOrigem.Range("F37&quot.Value

           wsDestino.Range("F33&quot.Value = wsOrigem.Range("F36&quot.Value

           wsDestino.Range("F34&quot.Value = wsOrigem.Range("F32&quot.Value

          

       Workbooks("002.xlsx&quot.Close SaveChanges:=True

      

              Workbooks.Open Filename:="C:\Users\Vinicius.Nascimento\Desktop\TESTE\003.xlsx"

          

       Set wsOrigem = Workbooks("003.xlsx&quot.Worksheets("RESUMO&quot

       Set wsDestino = Workbooks("RESUMO DOS ENSAIOS.xlsm&quot.Worksheets("RESUMO&quot

         

           wsDestino.Range("G7&quot.Value = wsOrigem.Range("F10&quot.Value

           wsDestino.Range("G8&quot.Value = wsOrigem.Range("F11&quot.Value

           wsDestino.Range("G9&quot.Value = wsOrigem.Range("F12&quot.Value

           wsDestino.Range("G10&quot.Value = wsOrigem.Range("F13&quot.Value

           wsDestino.Range("G11&quot.Value = wsOrigem.Range("F33&quot.Value

           wsDestino.Range("G12&quot.Value = wsOrigem.Range("F16&quot.Value

           wsDestino.Range("G13&quot.Value = wsOrigem.Range("F17&quot.Value

           wsDestino.Range("G14&quot.Value = wsOrigem.Range("F18&quot.Value

           wsDestino.Range("G15&quot.Value = wsOrigem.Range("F19&quot.Value

           wsDestino.Range("G16&quot.Value = wsOrigem.Range("F20&quot.Value

           wsDestino.Range("G17&quot.Value = wsOrigem.Range("F21&quot.Value

           wsDestino.Range("G18&quot.Value = wsOrigem.Range("F22&quot.Value

           wsDestino.Range("G19&quot.Value = wsOrigem.Range("F23&quot.Value

           wsDestino.Range("G20&quot.Value = wsOrigem.Range("F24&quot.Value

           wsDestino.Range("G21&quot.Value = wsOrigem.Range("F25&quot.Value

           wsDestino.Range("G22&quot.Value = wsOrigem.Range("F26&quot.Value

           wsDestino.Range("G23&quot.Value = wsOrigem.Range("F27&quot.Value

           wsDestino.Range("G24&quot.Value = wsOrigem.Range("F28&quot.Value

           wsDestino.Range("G25&quot.Value = wsOrigem.Range("F29&quot.Value

           wsDestino.Range("G26&quot.Value = wsOrigem.Range("F34&quot.Value

           wsDestino.Range("G27&quot.Value = wsOrigem.Range("F35&quot.Value

           wsDestino.Range("G31&quot.Value = wsOrigem.Range("F31&quot.Value

           wsDestino.Range("G32&quot.Value = wsOrigem.Range("F37&quot.Value

           wsDestino.Range("G33&quot.Value = wsOrigem.Range("F36&quot.Value

           wsDestino.Range("G34&quot.Value = wsOrigem.Range("F32&quot.Value

          

       Workbooks("003.xlsx&quot.Close SaveChanges:=True

      

       Application.ScreenUpdating = True

           

    End Sub

Anexos

RESUMO DOS ENSAIOS.xlsm
office excel vba dados varias trabalho resumo copiar pastas planilha ensaios
Responder
viniciussn
viniciussn Novo Membro Registrado
13 Mensagens 1 Curtida
#18 Por viniciussn
11/09/2018 - 08:35
EdsonBR disse:
@viniciussn, bom dia

Dá uma olhada se é isso.

@EdsonBR, bom dia!

É isso mesmo, você é genial!!! Muito obrigado.

Mas, como quase sempre depois que está pronto nós vemos algo a melhorar, queria te pedir um apoio novamente. É o seguinte: percebi que as planilhas do diretório 2 sempre terão mais dados que as planilhas do diretório 1, pois os ensaios realizados no campo é maior que os realizados no laboratório. Pensando nisso, o ideal pra mim, é que os dados fossem extraídos/copiados primeiramente das planilhas do diretório 2 e depois, ao localizar o número da amostra agora nas planilhas do diretório 1, os dados das planilhas do diretório 1 seriam copiados para o resumo.

Seria a mesma metodologia do que já está funcionando, só iria alterar a ordem.

Mas como você já me ajudou bastante no meu problema inicial, eu já daria o tópico como resolvido. Mas caso possa me ajudar um pouco mais, só tenho a lhe agradecer.
EdsonBR
EdsonBR Veterano Registrado
273 Mensagens 280 Curtidas
#19 Por EdsonBR
11/09/2018 - 09:23
Colega Vinicius, se vc observar bem ou se executar o código passo-a-passo notará que o código já faz isso.
Veja que a rotina CarregaDensidade abre todos os arquivos dos relatórios de densidade do Diretório 2, recolhe todos os valores de Número da Amostra, Posição e Altura da Camada, Densidade de Solo Seco, Grau de Compactação e Teor de Umidade e os coloca em uma matriz tipada (RelsDensidd()) para uso posterior. Então ao carregar os valores dos outros arquivos do Diretório 1, o código só busca pelo número da amostra aquela que já está nessa matriz. Essa etapa é feita com uma Collection para não ter de ficar fazendo Loop a cada vez, indo direto no índice da matriz.

Anexos

Matriz Type.png
LinkedIn
viniciussn
viniciussn Novo Membro Registrado
13 Mensagens 1 Curtida
#20 Por viniciussn
11/09/2018 - 10:20
EdsonBR disse:
Colega Vinicius, se vc observar bem ou se executar o código passo-a-passo notará que o código já faz isso.


@EdsonBR, entendi a sua explicação sobre o funcionamento do código. Me desculpa, é que eu não entendo praticamente nada de programação/VBA. Falando mais precisamente o problema que eu encontrei após rodar o código, é que quando te enviei os arquivos, só enviei uma parte (para não ficar pesado), pois são vários, e não tinha pensado no seguinte fato: Acontece que o "Nº da amostra" se repete em "algumas" colunas das planilhas do diretório 2, e com isso, ao copiar os dados solicitados (densidade, grau de compactação, umidade...), somente está copiando quando encontra a primeira vez. Por exemplo, se nas planilhas 001 e 002 do diretório 2 tiver o mesmo Nº da amostra, os dados só serão copiados da planilha 001, pois já foi localizado.

E por mais que o Nº da amostra se repete em outras colunas ou outras planilhas, os valores a serem copiados (densidade, grau de compactação, umidade...) são diferentes, então eu precisaria que se o número repetir, ele não fosse considerado novamente e procurasse o próximo. Isso resolveria toda a situação.

Mas como eu não entendo de programação, eu não sei o que é mais fácil ou vantajoso de ser fazer. Quando falei acima sobre alterar a ordem, eu queria dizer por exemplo que, primeiramente cada coluna (6 colunas/planilha) das planilhas do diretório 2 fossem copiados para o resumo. E quando fosse copiar o restante dos dados das planilhas do diretório 1, levasse em consideração o Nº da amostra, pois no diretório 1 o Nº da amostra não se repete, e dessa forma não daria errado.

Espero que tenha me compreendido o que mencionei acima, pois digitando é um pouco difícil de explicar e exemplificar.

De qualquer forma lhe agradeço sua ajuda.
viniciussn
viniciussn Novo Membro Registrado
13 Mensagens 1 Curtida
#21 Por viniciussn
15/09/2018 - 09:32
Bom dia!

Venho agradecer ao senhor @EdsonBR que me ajudou bastante a solucionar meus problemas. O Cara é fantástico no que faz, muito inteligente! É muito bom ver que existem pessoas que tiram um tempo do seu dia para ajudar outras que nem as conhece, sem qualquer intenção de ganho. Seu apoio facilitou e muito o meu trabalho. Muito sucesso pra você, obrigado! Tópico resolvido!
Responder Tópico
© 1999-2024 Hardware.com.br. Todos os direitos reservados.
Imagem do Modal