Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Copiar dados de vár...
 
Notifications
Clear all

Copiar dados de várias pastas de trabalhos diferentes

 
2024 - VBA & Macros
Post Recente por viniciussn 6 anos atrás
8 Posts
3 Usuários
0 Reactions
1,380 Visualizações
RSS
 viniciussn
(@viniciussn)
Posts: 11
Active Member
Topic starter
 

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:UsersVinicius.NascimentoDesktopTESTE01.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:UsersVinicius.NascimentoDesktopTESTE02.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:UsersVinicius.NascimentoDesktopTESTE03.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.

 
Postado : 10/08/2018 10:22 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

viniciussn,

Boa tarde!

Veja se é assim.

RESUMO DOS ENSAIOS.zip

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 10/08/2018 1:00 pm
 viniciussn
(@viniciussn)
Posts: 11
Active Member
Topic starter
 

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:

 wsDestino.Range("E7").Value = wsOrigem.Range("F10").Value

Desde já agradeço sua ajuda!

 
Postado : 10/08/2018 1:30 pm
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

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:

'Set wsOrigem = Workbooks(Arquivo).Worksheets("RESUMO")

Basta tirar o apóstrofo do início da linha. Fica assim:

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.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 10/08/2018 1:46 pm
 viniciussn
(@viniciussn)
Posts: 11
Active Member
Topic starter
 

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!

 
Postado : 11/08/2018 5:58 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

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.

RESUMO DOS ENSAIOS.zip

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 11/08/2018 10:09 am
EdsonBR
 EdsonBR
(@edsonbr)
Posts: 1057
Noble Member
 

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.

 
Postado : 11/08/2018 11:38 am
 viniciussn
(@viniciussn)
Posts: 11
Active Member
Topic starter
 

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.

 
Postado : 12/08/2018 4:41 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico