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

Visual Basic for Aplication e macros no Excel.
Regras do fórum
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde. Imagem

Copiar dados de várias pastas de trabalhos diferentes

Mensagempor viniciussn » Sex Ago 10, 2018 1:22 pm

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!

Código: Selecionar 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").Worksheets("RESUMO")
       Set wsDestino = Workbooks("RESUMO DOS ENSAIOS.xlsm").Worksheets("RESUMO")
         
           wsDestino.Range("E7").Value = wsOrigem.Range("F10").Value
           wsDestino.Range("E8").Value = wsOrigem.Range("F11").Value
           wsDestino.Range("E9").Value = wsOrigem.Range("F12").Value
           wsDestino.Range("E10").Value = wsOrigem.Range("F13").Value
           wsDestino.Range("E11").Value = wsOrigem.Range("F33").Value
           wsDestino.Range("E12").Value = wsOrigem.Range("F16").Value
           wsDestino.Range("E13").Value = wsOrigem.Range("F17").Value
           wsDestino.Range("E14").Value = wsOrigem.Range("F18").Value
           wsDestino.Range("E15").Value = wsOrigem.Range("F19").Value
           wsDestino.Range("E16").Value = wsOrigem.Range("F20").Value
           wsDestino.Range("E17").Value = wsOrigem.Range("F21").Value
           wsDestino.Range("E18").Value = wsOrigem.Range("F22").Value
           wsDestino.Range("E19").Value = wsOrigem.Range("F23").Value
           wsDestino.Range("E20").Value = wsOrigem.Range("F24").Value
           wsDestino.Range("E21").Value = wsOrigem.Range("F25").Value
           wsDestino.Range("E22").Value = wsOrigem.Range("F26").Value
           wsDestino.Range("E23").Value = wsOrigem.Range("F27").Value
           wsDestino.Range("E24").Value = wsOrigem.Range("F28").Value
           wsDestino.Range("E25").Value = wsOrigem.Range("F29").Value
           wsDestino.Range("E26").Value = wsOrigem.Range("F34").Value
           wsDestino.Range("E27").Value = wsOrigem.Range("F35").Value
           wsDestino.Range("E31").Value = wsOrigem.Range("F31").Value
           wsDestino.Range("E32").Value = wsOrigem.Range("F37").Value
           wsDestino.Range("E33").Value = wsOrigem.Range("F36").Value
           wsDestino.Range("E34").Value = wsOrigem.Range("F32").Value
           
       Workbooks("001.xlsx").Close SaveChanges:=True
       
       Workbooks.Open Filename:="C:\Users\Vinicius.Nascimento\Desktop\TESTE\002.xlsx"
           
       Set wsOrigem = Workbooks("002.xlsx").Worksheets("RESUMO")
       Set wsDestino = Workbooks("RESUMO DOS ENSAIOS.xlsm").Worksheets("RESUMO")
         
           wsDestino.Range("F7").Value = wsOrigem.Range("F10").Value
           wsDestino.Range("F8").Value = wsOrigem.Range("F11").Value
           wsDestino.Range("F9").Value = wsOrigem.Range("F12").Value
           wsDestino.Range("F10").Value = wsOrigem.Range("F13").Value
           wsDestino.Range("F11").Value = wsOrigem.Range("F33").Value
           wsDestino.Range("F12").Value = wsOrigem.Range("F16").Value
           wsDestino.Range("F13").Value = wsOrigem.Range("F17").Value
           wsDestino.Range("F14").Value = wsOrigem.Range("F18").Value
           wsDestino.Range("F15").Value = wsOrigem.Range("F19").Value
           wsDestino.Range("F16").Value = wsOrigem.Range("F20").Value
           wsDestino.Range("F17").Value = wsOrigem.Range("F21").Value
           wsDestino.Range("F18").Value = wsOrigem.Range("F22").Value
           wsDestino.Range("F19").Value = wsOrigem.Range("F23").Value
           wsDestino.Range("F20").Value = wsOrigem.Range("F24").Value
           wsDestino.Range("F21").Value = wsOrigem.Range("F25").Value
           wsDestino.Range("F22").Value = wsOrigem.Range("F26").Value
           wsDestino.Range("F23").Value = wsOrigem.Range("F27").Value
           wsDestino.Range("F24").Value = wsOrigem.Range("F28").Value
           wsDestino.Range("F25").Value = wsOrigem.Range("F29").Value
           wsDestino.Range("F26").Value = wsOrigem.Range("F34").Value
           wsDestino.Range("F27").Value = wsOrigem.Range("F35").Value
           wsDestino.Range("F31").Value = wsOrigem.Range("F31").Value
           wsDestino.Range("F32").Value = wsOrigem.Range("F37").Value
           wsDestino.Range("F33").Value = wsOrigem.Range("F36").Value
           wsDestino.Range("F34").Value = wsOrigem.Range("F32").Value
           
       Workbooks("002.xlsx").Close SaveChanges:=True
       
              Workbooks.Open Filename:="C:\Users\Vinicius.Nascimento\Desktop\TESTE\003.xlsx"
           
       Set wsOrigem = Workbooks("003.xlsx").Worksheets("RESUMO")
       Set wsDestino = Workbooks("RESUMO DOS ENSAIOS.xlsm").Worksheets("RESUMO")
         
           wsDestino.Range("G7").Value = wsOrigem.Range("F10").Value
           wsDestino.Range("G8").Value = wsOrigem.Range("F11").Value
           wsDestino.Range("G9").Value = wsOrigem.Range("F12").Value
           wsDestino.Range("G10").Value = wsOrigem.Range("F13").Value
           wsDestino.Range("G11").Value = wsOrigem.Range("F33").Value
           wsDestino.Range("G12").Value = wsOrigem.Range("F16").Value
           wsDestino.Range("G13").Value = wsOrigem.Range("F17").Value
           wsDestino.Range("G14").Value = wsOrigem.Range("F18").Value
           wsDestino.Range("G15").Value = wsOrigem.Range("F19").Value
           wsDestino.Range("G16").Value = wsOrigem.Range("F20").Value
           wsDestino.Range("G17").Value = wsOrigem.Range("F21").Value
           wsDestino.Range("G18").Value = wsOrigem.Range("F22").Value
           wsDestino.Range("G19").Value = wsOrigem.Range("F23").Value
           wsDestino.Range("G20").Value = wsOrigem.Range("F24").Value
           wsDestino.Range("G21").Value = wsOrigem.Range("F25").Value
           wsDestino.Range("G22").Value = wsOrigem.Range("F26").Value
           wsDestino.Range("G23").Value = wsOrigem.Range("F27").Value
           wsDestino.Range("G24").Value = wsOrigem.Range("F28").Value
           wsDestino.Range("G25").Value = wsOrigem.Range("F29").Value
           wsDestino.Range("G26").Value = wsOrigem.Range("F34").Value
           wsDestino.Range("G27").Value = wsOrigem.Range("F35").Value
           wsDestino.Range("G31").Value = wsOrigem.Range("F31").Value
           wsDestino.Range("G32").Value = wsOrigem.Range("F37").Value
           wsDestino.Range("G33").Value = wsOrigem.Range("F36").Value
           wsDestino.Range("G34").Value = wsOrigem.Range("F32").Value
           
       Workbooks("003.xlsx").Close SaveChanges:=True
       
       Application.ScreenUpdating = True
           
    End Sub


Editado por Patropi - Moderador
Favor não digitar todo o título em letras maiúsculas, pois na internet é grito - Leia as regras do fórum.
Você não está autorizado a ver ou baixar esse anexo.
Editado pela última vez por Patropi em Sáb Ago 11, 2018 1:23 pm, em um total de 1 vez.
Razão: Não é permitido todo o título em letras maiúsculas - Leia as regras do fórum
viniciussn
Membro
Membro
 
Mensagens: 11
Registrado em: Seg Jun 19, 2017 3:39 pm
Has thanked: 4 times
Have thanks: 0 time

{ SO_SELECT }

Re: COPIAR DADOS DE VÁRIAS PASTAS DE TRABALHOS DIFERENTES

Mensagempor wagner » Sex Ago 10, 2018 4:00 pm

viniciussn,

Boa tarde!

Veja se é assim.
Você não está autorizado a ver ou baixar esse anexo.
Se a resposta foi útil para você, por gentileza, Amigo, clique na mãozinha ao lado direito da ferramenta CITAR, no canto superior direito.

Atenciosamente
Wagner Morel
Avatar do usuário
wagner
Moderador
Moderador
 
Mensagens: 4299
Registrado em: Sáb Out 20, 2012 12:49 pm
Localização: Fortaleza - CE
Has thanked: 71 times
Have thanks: 1861 times

Re: COPIAR DADOS DE VÁRIAS PASTAS DE TRABALHOS DIFERENTES

Mensagempor viniciussn » Sex Ago 10, 2018 4:30 pm

Boa tarde Wagner...

Não sei se estou fazendo algo errado, mas deu o seguinte erro ("Erro em tempo de execução '91': A variável do objeto ou a variável do bloco 'With' não foi definida), no momento de executar o seguinte código:

Código: Selecionar todos
wsDestino.Range("E7").Value = wsOrigem.Range("F10").Value

Desde já agradeço sua ajuda!
Editado pela última vez por Patropi em Sáb Ago 11, 2018 1:24 pm, em um total de 2 vezes.
Razão: Não há necessidade de efetuar citações em resposta. Somente os trechos em que for necessários deverão ser citados
viniciussn
Membro
Membro
 
Mensagens: 11
Registrado em: Seg Jun 19, 2017 3:39 pm
Has thanked: 4 times
Have thanks: 0 time

Re: COPIAR DADOS DE VÁRIAS PASTAS DE TRABALHOS DIFERENTES

Mensagempor wagner » Sex Ago 10, 2018 4:46 pm

viniciussn,

Vixe cara! Pequeno erro meu. Desculpa aí. Quando comentei as linhas, acabei comentando uma linha que não é para comentar. Na linha abaixo que está assim:
Código: Selecionar todos
'Set wsOrigem = Workbooks(Arquivo).Worksheets("RESUMO")

Basta tirar o apóstrofo do início da linha. Fica assim:
Código: Selecionar todos
Set wsOrigem = Workbooks(Arquivo).Worksheets("RESUMO")

Salve e execute novamente.

Detalhe: Pedimos não fazer citações de inteiro teor das mensagens que lhe são encaminhadas. Não há necessidade. As citações devem restringir-se apenas a trechos das mensagens, quando estritamente necessárias ao entendimento por parte do seu interlocutor.
Se a resposta foi útil para você, por gentileza, Amigo, clique na mãozinha ao lado direito da ferramenta CITAR, no canto superior direito.

Atenciosamente
Wagner Morel
Avatar do usuário
wagner
Moderador
Moderador
 
Mensagens: 4299
Registrado em: Sáb Out 20, 2012 12:49 pm
Localização: Fortaleza - CE
Has thanked: 71 times
Have thanks: 1861 times

Re: COPIAR DADOS DE VÁRIAS PASTAS DE TRABALHOS DIFERENTES

Mensagempor viniciussn » Sáb Ago 11, 2018 8:58 am

Bom dia Wagner!

Fiz a alteração que você solicitou e o código rodou. Porém não funcionou pra mim. É porque cada arquivo (001, 002, 003...) tem que estar em uma das 22 colunas da planilha resumo. E como no código só ficou definido a primeira coluna "E", todos valores foram "inseridos" na coluna "E", e na verdade deveriam estar nas colunas (E, F, G, H, ...). Mesmo assim muito obrigado pela ajuda.

Outra coisa, caso ainda for tentar me ajudar mais com o código acima, eu esqueci de falar, eu gostaria de um código que por exemplo, se em um mês não tenha por exemplo 22 arquivos e tenha somente 10, então estes "10" arquivos sem colocados nas primeiras dez colunas, e não ficando algumas colunas em branco. E também caso em um mês tenha mais de 22 arquivos, não sei se é possível, mais eu gostaria que fosse criado uma nova aba automaticamente com os demais dados (023, 024, 025...). Mas se isso não for possível, não tem problema, eu faço manual, alterando o código quando acontecer o mencionado.

Desde já agradeço seu apoio! Um forte abraço meu amigo!
viniciussn
Membro
Membro
 
Mensagens: 11
Registrado em: Seg Jun 19, 2017 3:39 pm
Has thanked: 4 times
Have thanks: 0 time

Re: COPIAR DADOS DE VÁRIAS PASTAS DE TRABALHOS DIFERENTES

Mensagempor wagner » Sáb Ago 11, 2018 1:09 pm

viniciussn,

Boa tarde!

A nova versão que segue eu corrigi o problema de que tudo era gravado na coluna "E". Agora os arquivos serão gravados corretamente, a partir da coluna "E" e assim por diante.

Com relação a questão de quando não tiver os 22 arquivos em um determinado mês não há qualquer problema quanto a isso. Veja que logo no início do código eu armazeno cada um dos arquivos e em seguida vou testando se o arquivo existe ou não. Ou seja, se o arquivo não existir, nada será feito e o código pula para o próximo para testar se existe ou não. Com isso, só serão copiados os dados dos arquivos que existem. Como os dados do primeiro arquivo existente será copiado para a coluna "E", os dados dos demais arquivos existentes serão também copiados nas colunas seguintes. Ou seja: F, G H e assim por diante.

Quanto a questão de em um dado mês tiver mais de 22 arquivos e criar outra aba para copiar os dados dos demais, isso já é muito complexo de fazer. A melhor forma que vejo de você fazer isso é você fazer uma previsão da quantidade correta de arquivos e colocar tudo em uma aba só. Assim, logo no início do código, onde tem a linha FOR i = 1 to 22, você altera para a quantidade correta de arquivos e altera também as linhas de comandos referentes as cópias para refletir a realidade.
Você não está autorizado a ver ou baixar esse anexo.
Se a resposta foi útil para você, por gentileza, Amigo, clique na mãozinha ao lado direito da ferramenta CITAR, no canto superior direito.

Atenciosamente
Wagner Morel
Avatar do usuário
wagner
Moderador
Moderador
 
Mensagens: 4299
Registrado em: Sáb Out 20, 2012 12:49 pm
Localização: Fortaleza - CE
Has thanked: 71 times
Have thanks: 1861 times

Re: Copiar dados de várias pastas de trabalhos diferentes

Mensagempor EdsonBR » Sáb Ago 11, 2018 2:38 pm

Post cruzado em:
- Comunidade do Hardware: Copiar dados de várias pastas de trabalhos diferentes.
- Clube do Hardware: copiar dados de várias pastas de trabalhos diferentes

Por gentileza, aguarde um prazo por uma resposta antes de espalhar a mesma questão em diversos fóruns. Obrigado.
Imagem
Avatar do usuário
EdsonBR
Membro
Membro
 
Mensagens: 522
Registrado em: Qui Nov 05, 2015 11:43 pm
Localização: Joinville, SC
Has thanked: 104 times
Have thanks: 316 times

Re: Copiar dados de várias pastas de trabalhos diferentes

Mensagempor viniciussn » Dom Ago 12, 2018 7:41 pm

Muito obrigado EdsonBR!

Como eu estava desesperado tentando resolver, procurei todos os meios possíveis, pois não sabia onde eu teria uma resposta. Mas fico muito grato mesmo a você por ter me ajudado no outro fórum.

Deus abençoe você e Wagner, que me ajudaram bastante e continuam ajudando pessoas como eu.
Editado pela última vez por wagner em Seg Ago 13, 2018 9:41 am, em um total de 1 vez.
Razão: Não há necessidade de efetuar citações em resposta. Somente os trechos em que for necessários deverão ser citados
viniciussn
Membro
Membro
 
Mensagens: 11
Registrado em: Seg Jun 19, 2017 3:39 pm
Has thanked: 4 times
Have thanks: 0 time


Voltar para VBA & Macros

Quem está online

Usuários navegando neste fórum: Google [Bot] e 3 visitantes