Notifications
Clear all

IMPORTAR DADOS DE OUTRA WORBOOK

26 Posts
3 Usuários
0 Reactions
4,178 Visualizações
(@gallilleu)
Posts: 13
Active Member
Topic starter
 

Bom dia pessoal,

Estou com um problema para concluir um projeto na empresa que eu trabalho. Tenho uma workbook com várias abas (30-01, 30-02, 30-03...) cada uma corresponde a um determinado vendedor onde são preenchidas pelos mesmos. Tenho uma nova workbook com apenas uma aba (Relatorios) e eu gostaria que uma macro coletasse as informações contidas nas planilhas dos vendedores (30-01, 30-02, 30-03 ....) e copiasse para a planilha "Relatorios" para que eu consiga manipular os dados aplicando filtros. Essa importação tem apenas uma regra, quando a macro estiver "varrendo" as planilhas dos vendedores (30-01, 30-02, 30-03..) e encontrar uma linha vazia na coluna A ela tem que parar e ir para a próxima aba. Em anexo envio um modelo para melhor exemplificar.

 
Postado : 26/12/2013 6:24 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Se pesquisa na nossa base de dados, encontrara ajuda.

Pode ser de uma forma bem simples?

No seu arquivo (BancoDados.xls), ponha o código abaixo, esse código copiará todas guias para uma única guia, depois pegue essa única guia e leve para seu outro arquivo(Gestores.xls)

Option Explicit

Sub ConsolidarPlanilhas()
'Author:    Jerry Beaucaire
'Date:      6/26/2009
'Updated:  6/23/2010
'Merge all sheets in a workbook into one summary sheet (stacked)
'Data is sorted by a specific column name
Dim cs As Worksheet, ws As Worksheet
Dim LR As Long, NR As Long, sCol As Long
Dim sName As Boolean, SortStr As String
Application.ScreenUpdating = False

'From the headers in data sheets, enter the column title to sort by when finished
SortStr = "Cod"

'Add consolidation sheet if needed
If Not Evaluate("ISREF(PlanFinal!A1)") Then _
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "PlanFinal"

'Option to add sheet names to consolidation report
sName = MsgBox("Adicione o nome da folha de relatório de PlanFinal?", vbYesNo + vbQuestion) = vbYes

'Setup
Set cs = ActiveWorkbook.Sheets("PlanFinal")
cs.Cells.ClearContents
NR = 1

'Process each data sheet
    For Each ws In Worksheets
        If ws.Name <> cs.Name Then
            LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
            'customize this section to copy what you need
            If NR = 1 Then
              'copy titles and data to start the consolidation, edit row as needed for source of titles
                ws.Range("A1", ws.Cells(1, Columns.Count).End(xlToLeft)).Copy
                If sName Then
                    cs.Range("B1").PasteSpecial xlPasteAll
                Else
                    cs.Range("A1").PasteSpecial xlPasteAll
                End If
                NR = 2
            End If
            
            ws.Range("A2:BB" & LR).Copy    'copy data, edit as needed for the start row

            If sName Then      'paste and add sheet names if required
                cs.Range("B" & NR).PasteSpecial xlPasteValuesAndNumberFormats
                cs.Range("A" & NR, cs.Range("B" & cs.Rows.Count).End(xlUp).Offset(0, -1)) = ws.Name
            Else
                cs.Range("A" & NR).PasteSpecial xlPasteValuesAndNumberFormats
            End If
            
            NR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row + 1
        End If
    Next ws

'Sort
    LR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row
    On Error Resume Next
    sCol = cs.Cells.Find(SortStr, After:=cs.Range("A1"), LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column
    cs.Range("A1:BB" & LR).Sort Key1:=cs.Cells(2, sCol + (IIf(sName, 1, 0))), Order1:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Cleanup
    If sName Then cs.[A1] = "PlanFinal"
    cs.Rows(1).Font.Bold = True
    cs.Cells.Columns.AutoFit
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    cs.Activate
    Range("A1").Select
    Set cs = Nothing
End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 26/12/2013 7:28 am
(@gallilleu)
Posts: 13
Active Member
Topic starter
 

Alexandre, bom dia.

Primeiramente gostaria de agradecer o suporte prestado. Inseri o código e apontei para um botão, mas o resultado não chegou no esperado. Na consolidação dos dados ele acabou copiando apenas o primeiro nome de cada planilha. Eu encontrei um código e gostaria de ajuda para ajusta-lo.
Esse código ele pede para você apontar o(s) arquivo(s) e depois disso ele faz um laço de repetição copiando os dados de todas as planilhas dos vendedores para a matriz.
A única coisa que preciso ajustar é o seguinte: Não sei quantas abas vou ter dentro de cada arquivo e o laço pede o numero exato de abas para percorrer e também ele não deixa eu selecionar o intervalo desejado a ser copiado que seria A6:P224 de cada aba percorrida.

Segue o código:
Sub BuscarInformações()

Dim wb As Workbook
Dim ws As Worksheet
Dim lngRemoto As Long
Dim lngEu As Long
Dim lngCounter As Long

Application.ScreenUpdating = False

With ActiveSheet
For lngCounter = 1 To 6
Set wb = Workbooks.Open(Application.GetOpenFilename)
Set ws = wb.Sheets(1)

lngEu = .Cells(.Rows.Count, "A").End(xlUp).Row
lngRemoto = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

ws.Range(IIf(lngRemoto - 9 < 1, 1, lngRemoto - 9) & ":" & lngRemoto).EntireRow.Copy Destination:=.Range("A" & lngEu + 1)
wb.Close False
Next lngCounter
End With

Set ws = Nothing
Set wb = Nothing
Application.ScreenUpdating = True

End Sub

 
Postado : 26/12/2013 7:47 am
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

gallilleu,

Bom Dia!

Segue, abaixo, minha sugestão. No seu arquivo de dados não há necessidade da palavra <vazia>. O código encontrará essa linha e pára, pasando para a outra aba. Veja se assim lhe atende.

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 : 26/12/2013 7:49 am
(@gallilleu)
Posts: 13
Active Member
Topic starter
 

Alexandre, bom dia.

Primeiramente gostaria de agradecer o suporte prestado. Inseri o código e apontei para um botão, mas o resultado não chegou no esperado. Na consolidação dos dados ele acabou copiando apenas o primeiro nome de cada planilha. Eu encontrei um código e gostaria de ajuda para ajusta-lo.
Esse código ele pede para você apontar o(s) arquivo(s) e depois disso ele faz um laço de repetição copiando os dados de todas as planilhas dos vendedores para a matriz.
A única coisa que preciso ajustar é o seguinte: Não sei quantas abas vou ter dentro de cada arquivo e o laço pede o numero exato de abas para percorrer e também ele não deixa eu selecionar o intervalo desejado a ser copiado que seria A6:P224 de cada aba percorrida.

Segue o código:
Sub BuscarInformações()

Dim wb As Workbook
Dim ws As Worksheet
Dim lngRemoto As Long
Dim lngEu As Long
Dim lngCounter As Long

Application.ScreenUpdating = False

With ActiveSheet
For lngCounter = 1 To 6
Set wb = Workbooks.Open(Application.GetOpenFilename)
Set ws = wb.Sheets(1)

lngEu = .Cells(.Rows.Count, "A").End(xlUp).Row
lngRemoto = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

ws.Range(IIf(lngRemoto - 9 < 1, 1, lngRemoto - 9) & ":" & lngRemoto).EntireRow.Copy Destination:=.Range("A" & lngEu + 1)
wb.Close False
Next lngCounter
End With

Set ws = Nothing
Set wb = Nothing
Application.ScreenUpdating = True

End Sub

gallilleu
Membro
Membro

Mensagens: 2
Registrado em: Hoje, 08:41
Agradeceu : 0 time
Foi agradecido: 0 time

Bom dia!!

Se pesquisa na nossa base de dados, encontrara ajuda.

Pode ser de uma forma bem simples?

No seu arquivo (BancoDados.xls), ponha o código abaixo, esse código copiará todas guias para uma única guia, depois pegue essa única guia e leve para seu outro arquivo(Gestores.xls)

Option Explicit

Sub ConsolidarPlanilhas()
'Author:    Jerry Beaucaire
'Date:      6/26/2009
'Updated:  6/23/2010
'Merge all sheets in a workbook into one summary sheet (stacked)
'Data is sorted by a specific column name
Dim cs As Worksheet, ws As Worksheet
Dim LR As Long, NR As Long, sCol As Long
Dim sName As Boolean, SortStr As String
Application.ScreenUpdating = False

'From the headers in data sheets, enter the column title to sort by when finished
SortStr = "Cod"

'Add consolidation sheet if needed
If Not Evaluate("ISREF(PlanFinal!A1)") Then _
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "PlanFinal"

'Option to add sheet names to consolidation report
sName = MsgBox("Adicione o nome da folha de relatório de PlanFinal?", vbYesNo + vbQuestion) = vbYes

'Setup
Set cs = ActiveWorkbook.Sheets("PlanFinal")
cs.Cells.ClearContents
NR = 1

'Process each data sheet
    For Each ws In Worksheets
        If ws.Name <> cs.Name Then
            LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
            'customize this section to copy what you need
            If NR = 1 Then
              'copy titles and data to start the consolidation, edit row as needed for source of titles
                ws.Range("A1", ws.Cells(1, Columns.Count).End(xlToLeft)).Copy
                If sName Then
                    cs.Range("B1").PasteSpecial xlPasteAll
                Else
                    cs.Range("A1").PasteSpecial xlPasteAll
                End If
                NR = 2
            End If
            
            ws.Range("A2:BB" & LR).Copy    'copy data, edit as needed for the start row

            If sName Then      'paste and add sheet names if required
                cs.Range("B" & NR).PasteSpecial xlPasteValuesAndNumberFormats
                cs.Range("A" & NR, cs.Range("B" & cs.Rows.Count).End(xlUp).Offset(0, -1)) = ws.Name
            Else
                cs.Range("A" & NR).PasteSpecial xlPasteValuesAndNumberFormats
            End If
            
            NR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row + 1
        End If
    Next ws

'Sort
    LR = cs.Range("A" & cs.Rows.Count).End(xlUp).Row
    On Error Resume Next
    sCol = cs.Cells.Find(SortStr, After:=cs.Range("A1"), LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Column
    cs.Range("A1:BB" & LR).Sort Key1:=cs.Cells(2, sCol + (IIf(sName, 1, 0))), Order1:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Cleanup
    If sName Then cs.[A1] = "PlanFinal"
    cs.Rows(1).Font.Bold = True
    cs.Cells.Columns.AutoFit
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    cs.Activate
    Range("A1").Select
    Set cs = Nothing
End Sub

Att

 
Postado : 26/12/2013 7:50 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!
:shock:
Eu fiz os testes e não tive problema, teste a sugestão do Wagner, depois nos falamos!!

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 26/12/2013 7:55 am
(@gallilleu)
Posts: 13
Active Member
Topic starter
 

Bom dia Wagner,

Apresentou um erro ao executar na linha:

UltimaLinhaRelat = Workbooks(PlanRelat).Sheets("Relatorio").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
Workbooks(PlanBD).Activate

gallilleu,

Bom Dia!

Segue, abaixo, minha sugestão. No seu arquivo de dados não há necessidade da palavra <vazia>. O código encontrará essa linha e pára, pasando para a outra aba. Veja se assim lhe atende.

 
Postado : 26/12/2013 7:59 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Eu não olhei o arquivo postado pelo Wagrner, mas tente...

Onde há Workbooks(PlanRelat) e Workbooks(PlanBD).Activate

Tente digitar o nome exato do arquivo

Workbooks("NomeArquivo.xls") e Workbooks("NomeArquivo.xls").Activate

Se for xls ou xlsm terá que digitar exatamente a extenção do arquivo.
Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 26/12/2013 8:08 am
(@gallilleu)
Posts: 13
Active Member
Topic starter
 

Ainda não deu certo :|

Segue o código:

Sub Copiar()
Application.StatusBar = "Aguarde por favor... Copiando dados!"
Application.ScreenUpdating = False
Dim i, j, UltimaLinhaRelat, UltimaLinhaBD As Long
Dim PlanRelat, PlanBD As String
For Each Wkb In Workbooks
If Left(Wkb.Name, 8) = "Gestores" Then PlanRelat = "Gestores.xlsm"
If Left(Wkb.Name, 10) = "BancoDados" Then PlanBD = "BancoDados.xlsx"
Next
UltimaLinhaRelat = Workbooks("Gestores.xlsm").Sheets("Relatorio").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
Workbooks("BancoDados.xlsx").Activate
For i = 1 To Sheets.Count
Sheets(i).Select
UltimaLinhaBD = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row
For j = 1 To UltimaLinhaBD
Range("A2:E" & UltimaLinhaBD).Select
Selection.Copy
Windows(PlanRelat).Activate
Range("A" & UltimaLinhaRelat).Select
ActiveSheet.Paste
Windows(BancoDados.xlsx).Activate
Application.CutCopyMode = False
Range("A1").Select
Next
UltimaLinhaRelat = Workbooks(PlanRelat).Sheets("Relatorio").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
Next
Windows(PlanRelat).Activate
Application.ScreenUpdating = True
MsgBox "Dados Copiados com Sucesso!", vbDefaultButton1, "CÓPIA DE DADOS"
Application.StatusBar = " "
End Sub

Bom dia!!

Eu não olhei o arquivo postado pelo Wagrner, mas tente...

Onde há Workbooks(PlanRelat) e Workbooks(PlanBD).Activate

Tente digitar o nome exato do arquivo

Workbooks("NomeArquivo.xls") e Workbooks("NomeArquivo.xls").Activate

Se for xls ou xlsm terá que digitar exatamente a extenção do arquivo.
Att

 
Postado : 26/12/2013 8:16 am
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

gallilleu,

Muito estranho... seus arquivos não possuem os nomes iguais aos que você anexou aqui? Há alguma mudança com relação ao nome dos arquivos ou com relação ao nome da aba "Relatorio"?

Pergunto isso porque acabei de testar e não ocorreu erro nenhum aqui...

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 : 26/12/2013 8:23 am
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

Veja a imagem da tela do teste:

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 : 26/12/2013 8:28 am
(@gallilleu)
Posts: 13
Active Member
Topic starter
 

Wagner,

Eu estava recebendo o código e adaptando para a minha planilha desejada. Mas acho melhor disponibilizar a minha planilha "Matriz"(Gestores) e a planilha "Filha"(Bauru).

Como a planilha "Matriz" (Gestores) deve funcionar?
Quando eu clicar no botão: "Bauru" da planilha "Matriz" (Gestores), ela precisa importar os dados da planilha "Filha" (Bauru) e colar na "Matriz" (Gestores).

Em anexo segue as planilhas.

Vale lembrar que não sabemos o número exato de abas que as planilhas Filhas podem ter.

gallilleu,

Muito estranho... seus arquivos não possuem os nomes iguais aos que você anexou aqui? Há alguma mudança com relação ao nome dos arquivos ou com relação ao nome da aba "Relatorio"?

Pergunto isso porque acabei de testar e não ocorreu erro nenhum aqui...

 
Postado : 26/12/2013 8:49 am
(@gallilleu)
Posts: 13
Active Member
Topic starter
 

Wagner,

Eu estava recebendo o código e adaptando para a minha planilha desejada. Mas acho melhor disponibilizar a minha planilha "Matriz"(Gestores) e a planilha "Filha"(Bauru).

Como a planilha "Matriz" (Gestores) deve funcionar?
Sempre quando eu clicar em algum botão relacionado a alguma cidade, ele localiza a primeira linha vazia da planilha "Matriz" (Gestores) e cola. Neste exemplo quando eu clicar no botão: "Bauru" da planilha "Matriz" (Gestores), ela precisa importar os dados da planilha "Filha" (Bauru) e colar na "Matriz" (Gestores).

Em anexo segue as planilhas.

Vale lembrar que não sabemos o número exato de abas que as planilhas Filhas podem ter.

gallilleu,

Muito estranho... seus arquivos não possuem os nomes iguais aos que você anexou aqui? Há alguma mudança com relação ao nome dos arquivos ou com relação ao nome da aba "Relatorio"?

Pergunto isso porque acabei de testar e não ocorreu erro nenhum aqui...

 
Postado : 26/12/2013 9:00 am
Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

gallilleu,

No arquivo anexo, resolvi o problema da cópia dos dados, de acordo com as suas planilhas. Clique no botão Bauru e os dados serão copiados. Se a planilha Bauru tiver várias abas e estas várias abas contiverem dados, todos eles serão copiados.

Entretanto, isso não resolve o problema dos outros botões. Para os outros você deverá criar Procedures similares a de Bauru. Isso faria seu código ficar muito grande. Uma solução seria utilizar a mesma Procedure de Bauru para os demais botões. Obviamente, nesse caso, o código terá que ser alterado de modo que se possa solicitar ao usuário, logo após o clique no botão, o nome da cidade que quer copiar os dados. Esse nome passaria para uma variável que alimentaria o código. Assim, você teria um só código para todos os botões.

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 : 26/12/2013 9:16 am
(@gallilleu)
Posts: 13
Active Member
Topic starter
 

Wagner,

Só preciso de mais um detalhezinho. Vamos aperfeiçoar o código?

Para ele ficar excelente e atender tudo o que eu preciso, preciso apenas de dois ajustes. O primeiro é referente a cópia dos dados, nós conseguimos implementar algo que abra a planilha "Filha" sozinha, copie, feche e cole na planilha "Matriz"? Encontrei um trecho parecido com o que eu preciso. Este código abri a planilha onde contém os dados efetua a cópia das células desejadas, fecha e cola na planilha "Matriz". Deste modo não precisamos manter todas as planilhas abertas.

Exemplo: Abri arquivo / copia / fecha arquivo / cola celulas
If wbDest Is Nothing Then
Set wbDest = Workbooks.Open("C:TempTeste2.xlsx")
On Error GoTo 0
End If

ThisWorkbook.Sheets("Plan2").Range("D1:D32").Copy _
wbDest.Sheets("Plan1").Range("D1")
Application.DisplayAlerts = False
With wbDest
.SaveAs
.Close

E por fim gostaria de implementar essa alternativa que você disse sobre escolher a cidade através do teclado e armazena em uma variável. Apenas gostaria de dizer que o usuário pode escolher várias cidades simultaneamente, a cada escolha de cidade os dados terão que serem colados na primeira linha vazia seguindo uma sequencia. Caso essa segunda etapa seja trabalhosa e demorada, não me importo em redigir os trechos um para cada botão (ITÁPOLIS, ITAJOBI, BAURU, PIRAJU.....)

gallilleu,

No arquivo anexo, resolvi o problema da cópia dos dados, de acordo com as suas planilhas. Clique no botão Bauru e os dados serão copiados. Se a planilha Bauru tiver várias abas e estas várias abas contiverem dados, todos eles serão copiados.

Entretanto, isso não resolve o problema dos outros botões. Para os outros você deverá criar Procedures similares a de Bauru. Isso faria seu código ficar muito grande. Uma solução seria utilizar a mesma Procedure de Bauru para os demais botões. Obviamente, nesse caso, o código terá que ser alterado de modo que se possa solicitar ao usuário, logo após o clique no botão, o nome da cidade que quer copiar os dados. Esse nome passaria para uma variável que alimentaria o código. Assim, você teria um só código para todos os botões.

 
Postado : 26/12/2013 9:33 am
Página 1 / 2