Um dia era pra mostrar coisas sobre o excel, hoje é para compartilhar meus poucos conhecimentos, com os interessados!

domingo, 29 de julho de 2018

VBA - Excel 2003 - Unificando planilhas



Abrir e fechar planilhas para vincular dados?
Unifique!!!!

Curta a minha pagina, para novidades! Qbexcel

Bom vamos ao exemplo:

Varias planilhas com uma mesma pasta, nelas estão as 3 colunas NOME = Coluna 1, CPF = Coluna 2, Telefone = Coluna 3.

São muitos dados para ficar abrindo e fechando, copiando e colando, a demanda é alta, o que fazer?
Neste caso é possível utilizar o VBA para resolver este dilema.
  • Abra o VBA no Excel (Alt+F11)
  • Insira um modulo
  • Dentro do modulo, insira um procedimento
  • Dentro do procedimento, cole o código abaixo!
  • Observe o que está em vermelho no Script, é o minimo de alteração que você precisa executar.
______________________________________________________________________

Dim xl As New Excel.Application 'Declara a variável XL como novo aplicativo do Excel.
Dim xlw As Excel.Workbook 'Declara a variável XLW prepara grupo de trabalho, como aplicativo de Excel aberto.
Dim vItem As Variant 'Declara a primeira variável como tipo de data "Variant".

With Application.FileSearch 'Loop para localizar arquivos.
 .Filename = strFileName 'strFileName é a variável que assume o nome do arquivo.
 .LookIn = "C:\planilhas" ' Este campo você inclui o caminho Ex. "C:\planilhas".
 .SearchSubFolders = True 'Inclui busca em subdiretórios.
 .Execute 'Executa a Função de procura.

    For Each vItem In .FoundFiles 'Assume para cada Vitem o nome dos arquivos encontrados.
       Set xlw = xl.Workbooks.Open(vItem) 'Assume a Variável VItem como grupo de trabalho do aplicativo Excel.
       
       'aqui eu defini um grupo linhas e colunas com função FOR para retorno dos valores que busco.
       For lin = 1 To 10 'Aqui ele faz uma consulta da linha 1 até a linha 10
           For col = 1 To 3 'Aqui ele faz uma consulta da coluna 1 até a coluna 3
               Cells(valor + lin, col).Value = xlw.Application.Cells(lin, col).Value 'Cells(linha, coluna).value = Destino da busca e xlw.Application.Cells(lin, COL).Value = Origem da Busca.
           Next col 'Fim de Loop de colunas
       Next lin 'Fim de Loop de linhas.
       
       Set xlw = Nothing 'Zera a variavel xlw.
       
       '************************************************************
       'Kill vItem 'Deleta o arquivo dentro do caminho da varivel vItem.
    Next vItem 'Calcula a próxima variável vItem.

       '**********************************************************************
 xlw.Sheets("Detalhes").Select 'Seleciona a planilha "Detalhes" da Variavel vItem aberta

    valor = Range("a65536").End(xlUp).Row 'Assume o valor da ultima linha preenchida da coluna A
    xlw.Close False 'Fecha a Planilha aberta com origem de dados.
    Set xl = Nothing 'Zera a variavel xlw.
End With 'Vai retornar o Looping de busca dos arquivos XLS até achar todos.

______________________________________________________________________



Video de apoio: 


Arquivo de Exemplo: Download

Dica, para utilizar este script em outras versões de excel, por exemplo o 2007, 2013 / 2016, não se esqueça de adicionar a referencia do office 2003 no seu computador.

https://www.microsoft.com/en-us/download/confirmation.aspx?id=7155