none
Exportando Dados (VBA) RRS feed

  • Pergunta

  •  

    Olá Pessoal!

     

    Estou fazendo um formulário que deverá ser preenchido por várias pessoas. Gostaria de exportar os dados destas planilhas para uma única, onde eu possa trabalhar os dados de todas as filiais ao mesmo tempo.

    Alguém tem um exemplo de como fazer esta exportação?

     

    [ ]s

    quarta-feira, 9 de abril de 2008 18:28

Respostas

  • Às ordens, Panddora.

    Se surgirem mais dúvidas, vamos continuar até termos o teu aplicativo montado.

    Só não esqueça de marcar a resposta definitiva caso tenhamos concluído o assunto.

    [ ]s e até a próxima.

     

     

     

     

    quinta-feira, 10 de abril de 2008 18:23

Todas as Respostas

  • Segue exemplo:

    Code Snippet

    Sub Importar_Consolidar()
    Dim i As Integer, N As Integer, k As Integer
    Dim Origem As Worksheet, Destino As Worksheet

     

    'Permite a continuidade do código caso haja erro
    On Error Resume Next


    'Estabelece como destino uma planilha do arquivo chamada Destino
    Set Destino = ThisWorkbook.Worksheets("Destino")


    'Existe uma planilha chamada "Setup" no arquivo de destino em cuja coluna A está a lista
    'de nomes completos dos arquivos (nome completo = diretório + arquivo

    For i = 1 To Sheets("Setup").Cells(Rows.Count, 1).End(xlUp).Row

    'Ao longo do loop são abertos cada um dos arquivos listados
       
        Workbooks.Open (Sheets("Setup").Cells(i, 1))

    'Em cada um dos arquivos abertos, as informações que serão copiadas estão numa planilha
    'chamada "Dados"
       
        Set Origem = ActiveWorkbook.Sheets("Dados")

    'É determinado a última linha da coluna A que contém informações na planilha "Dados"
       
        N = Origem.Cells(Rows.Count, 1).End(xlUp).Row
       
    'As informações da coluna A da planilha Origem são transferidas para a a última linha preenchida
    'da coluna A da planilha Destino

        Origem.Range(Cells(1, 1), Cells(N, 1)).Copy Destino.Cells(Destino.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
       
    'Ao lado do nome do arquivo na planilha "Setup" é colocado o Ok caso tenha ocorrido a importação ou Não Ok
    'Caso tenha havido problemas de importação


        If Err.Number <> 0 Then
        ThisWorkbook.Sheets("Setup").Cells(i, 2) = "OK"
        ActiveWindow.Close SaveChanges:=False
        Else
        ThisWorkbook.Sheets("Setup").Cells(i, 2) = "Não OK"
        End If
    Next i


    End Sub

     

     

     

    quarta-feira, 9 de abril de 2008 20:40
  • Olá, Adilson

     

    Tentei executar esta sub, mas não sei se entendi errado a sua lógica...infelizmente não funcionou.

    Poderia me ajudar?

    Digamos que eu tenha três arquivos para exportar : Filial_Consolação.xls, Filial_Pinheiros.xls e Filial_Anhembi.xls, estas três possuem os mesmos campos com os mesmos nomes.

    Quero transferir estes dados que estão armazenados em uma planilha chamada "Dados" em um arquivo chamado "Principal", planilha "Dados".

    Vamos lá:

     

    'Estabelece como destino uma planilha do arquivo chamada Destino
    Set Destino = ThisWorkbook.Worksheets("Destino")

    --> Posso entender que devo trocar a palavra "Destino" por "Principal", pois, é o local que irá armazenas todos os meus dados?

     

    'Existe uma planilha chamada "Setup" no arquivo de destino em cuja coluna A está a lista
    'de nomes completos dos arquivos (nome completo = diretório + arquivo

    For i = 1 To Sheets("Setup").Cells(Rows.Count, 1).End(xlUp).Row

    --> Coloquei na coluna A sem cabeçalho, os seguintes endereços:

    C:\Filial_Consolação.xls

    C:\Filial_Pinheiros.xls

    C:\Filial_Anhembi.xls

     

    Workbooks.Open (Sheets("Setup").Cells(i, 1))

    'Em cada um dos arquivos abertos, as informações que serão copiadas estão numa planilha
    'chamada "Dados"
    --> OK

     

        Set Origem = ActiveWorkbook.Sheets("Dados")

    'É determinado a última linha da coluna A que contém informações na planilha "Dados"
       N = Origem.Cells(Rows.Count, 1).End(xlUp).Row
    --> Nesta parte, ele ativa a planilha "Dados" do primeiro arquivo, correto e depois identifica a última linha..acho que esta parte deu para entender...

     

    'As informações da coluna A da planilha Origem são transferidas para a a última linha preenchida
    'da coluna A da planilha Destino

        Origem.Range(Cells(1, 1), Cells(N, 1)).Copy Destino.Cells(Destino.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)

    --> Ou seja, neste momentos os dados da primeira planilha serão copiados para a planilha "Principal" a partir da última linha..

     

    'Ao lado do nome do arquivo na planilha "Setup" é colocado o Ok caso tenha ocorrido a importação ou Não Ok
    'Caso tenha havido problemas de importação


        If Err.Number <> 0 Then
        ThisWorkbook.Sheets("Setup").Cells(i, 2) = "OK"
        ActiveWindow.Close SaveChanges:=False
        Else
        ThisWorkbook.Sheets("Setup").Cells(i, 2) = "Não OK"
        End If
    Next i

    --> Neste momento dados não são copiados, mas aparece OK ao lado dos arquivos.

     

    PS.: Copiei esta sub direto no botão dentro da planilha "Principal". Onde posso ter errado?

     

    Obrigada pela ajuda!

    quinta-feira, 10 de abril de 2008 15:33
  • Seguem os meus comentários, destacados em vermelho, para as suas observações que necessitam esclarecimentos.

     

    'Estabelece como destino uma planilha do arquivo chamada Destino
    Set Destino = ThisWorkbook.Worksheets("Destino")

    --> Posso entender que devo trocar a palavra "Destino" por "Principal", pois, é o local que irá armazenas todos os meus dados?

    --> No caso da tua estrutura de arquivos / planilhas, vc deve substituir "Destino" por "Dados", que é a planilha do arquivo "Principal" que receberá as informações consolidadas

    Set Destino = ThisWorkbook.Worksheets("Dados")

     

    'As informações da coluna A da planilha Origem são transferidas para a a última linha preenchida
    'da coluna A da planilha Destino

        Origem.Range(Cells(1, 1), Cells(N, 1)).Copy Destino.Cells(Destino.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)

    --> Ou seja, neste momentos os dados da primeira planilha serão copiados para a planilha "Principal" a partir da última linha..

    --> Aqui é necessário que vc faça adaptações com base na tua estrutura de dados. Da forma que está escrito todo o conteúdo da coluna A da planilha "Dados" de cada um dos arquivos é transferido para a planilha "Dados" do arquivo principal. Se, por exemplo, não quiser copiar a linha inicial (onde pode existir um cabeçalho), vc poderia colocar:

     Origem.Range(Cells(2, 1), Cells(N, 1)).....

    Se quiser, copiar as colunas de A a C, fica assim

     Origem.Range(Cells(1, 1), Cells(N, 3))....

    Ou seja, depende da organização de suas bases de dados. Se puder fornecer mais detalhes poderei auxiliá-la melhor.

     

    'Ao lado do nome do arquivo na planilha "Setup" é colocado o Ok caso tenha ocorrido a importação ou Não Ok
    'Caso tenha havido problemas de importação


        If Err.Number <> 0 Then
        ThisWorkbook.Sheets("Setup").Cells(i, 2) = "OK"
        ActiveWindow.Close SaveChanges:=False
        Else
        ThisWorkbook.Sheets("Setup").Cells(i, 2) = "Não OK"
        End If

     

    --> Aqui houve um erro da minha parte, os comandos corretos são:

     

        If Err.Number = 0 Then
        ThisWorkbook.Sheets("Setup").Cells(i, 2) = "OK"
        ActiveWindow.Close SaveChanges:=False
        Else
        ThisWorkbook.Sheets("Setup").Cells(i, 2) = "Não OK"
        End If

    Espero que tenha esclarecidos os pontos levantados. Simulei o funcionamento com a estrutura que vc informou e a importação funcionou corretamente.

    Avise se funcionou corretamente.

     

    [ ]s

     

     

    quinta-feira, 10 de abril de 2008 16:49
  • Fiz as alterações necessárias e agora deu tudo certo. O próximo passo agora é copiar as colunas certas, caso eu me atrapalhe, volto a pedir socorro.

     

    Obrigada pelas dicas

     

    [ ]s

    quinta-feira, 10 de abril de 2008 18:03
  • Às ordens, Panddora.

    Se surgirem mais dúvidas, vamos continuar até termos o teu aplicativo montado.

    Só não esqueça de marcar a resposta definitiva caso tenhamos concluído o assunto.

    [ ]s e até a próxima.

     

     

     

     

    quinta-feira, 10 de abril de 2008 18:23