Usuário com melhor resposta
Criar novas planilhas a partir do filtro de uma coluna

Pergunta
-
Olá,
Tenho uma planilha com dados de passagens emitidas para filiais. Tenho uma coluna com o código das filiais, e eu preciso que esses dados sejam separados em várias planilhas, com os dados da respectiva filial.
[Se no filtro eu tenho 3 códigos, eu preciso, que quando eu executar, sejam criadas 3 planilhas separadas da mesma forma da principal, porém somente com os dados da filial 1, depois da 2 e da 3.]
Gostaria de saber como posso fazer isso sem ter que fazer um filtro estático, pois as filiais sempre mudam eu sempre tenho que alterar os filtros que quero no código.
:)
Respostas
-
Boa tarde Lidiq!
Mil desculpas, o erro foi meu. Substitua a linha:
For lngBD = Lini To 7 '.Cells(.Rows.Count, "A").End(xlUp).Row
por:
For lngBD = Lini To .Cells(.Rows.Count, "A").End(xlUp).Row
Eu tinha colocado o número 7 pra não precisar gerar a lista inteira, apenas no momento dos testes, mas me esqueci de apagar!
Aproveitando, troque o n° 8 a seguir por 2 (as abas tem seu cabeçalho na linha 1):
LiniAbas = 2 '8 'Após cabeçalho nas Abas a Exportar
ou copie o logo também para as abas, substituindo:
wksBD.Rows(Lini - 1).Copy wks.Rows(1)
por
wksBD.Rows("1:" & Lini - 1).Copy wks.Rows(1)
Espero que dessa forma funcione!
Um abraço.
Filipe Magno
- Marcado como Resposta Lidiq terça-feira, 18 de junho de 2013 20:29
Todas as Respostas
-
Considere que o banco de dados está numa planilha que chama BD, existe uma linha de cabeçalho e os códigos estão na coluna A:
Sub fMain() Dim lngBD As Long Dim lngLast As Long Dim wksBD As Worksheet Dim wks As Worksheet Set wksBD = ThisWorkbook.Sheets("BD") With wksBD For lngBD = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row Set wks = Nothing On Error Resume Next Set wks = ThisWorkbook.Sheets(CStr(.Cells(lngBD, "A"))) On Error GoTo 0 If wks Is Nothing Then Set wks = ThisWorkbook.Sheets.Add wks.Name = CStr(.Cells(lngBD, "A")) wksBD.Rows(1).Copy wks.Rows(1) End If lngLast = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row + 1 wksBD.Rows(lngBD).Copy wks.Rows(lngLast) Next lngBD End With End Sub
Felipe Costa Gualberto - http://www.ambienteoffice.com.br
-
Boa noite Lidiq!
Além da forma proposta pelo Felipe acima, através de uma macro, existe também a possibilidade de se fazer isso de forma quase automática pelo próprio excel, através do uso de uma Tabela Dinâmica.
Para tanto, basta que o campo que você deseja criar as Abas seja um campo de "Página" (ou "Filtro de Relatório) na sua Tabela Dinâmica. Em seguida, basta fazer o seguinte procedimento:
- Na Aba "Opções" da "Ferramentas da Tabela Dinâmica" clique em "Opções" e em seguida em "Mostrar Páginas do Filtro de Relatório...".
- Basta confirmar clicando em "Ok". Pronto!
Esses nomes valem para o Excel 2007+, mas o recurso também está disponível no Excel 2003, mas não me lembro se os nomes dos campos são os mesmos (o procedimento é idêntico).
Espero que ajude.
Abraço.
Filipe Magno
-
Benzadeus,
Obrigada pela ajuda!!
Acho que eu não me expressei direito :P eu testei o código e funcionou perfeitamente, porém, criou várias abas, minha intenção era criar outras Planilhas com o mesmo cabeçalho da planilha principal. E vou precisar fazer mais de 1 filtro em um caso específico.
Vou separar todas as filiais, mas quando chegar na filial 999999 eu vou precisar dividi-las pelo Centro de Custo [outra coluna]
é possivel?
-
-
Boa noite Lidiq!
Para usar a opção que sugeri, você precisa primeiro criar uma Tabela Dinâmica a partir de seus dados e selecionar uma célula qualquer dentro dessa planilha, para que então o Menu especial que citei apareça. De qualquer forma, o resultado é semelhante ao produzido pelo código do Felipe (resultado em Abas), que pelo que entendi não é bem o que você precisa.
Não entendi muito bem o que você precisa como resultado final (nem como você aplicaria os filtros), mas penso que será possível apenas através de uma Macro. Talvez se você colocar algumas imagens com o resultado final desejado (ou uma planilha exemplo no SkyDrive) fique mais fácil pra entender e propor uma solução.
Vlw!
Filipe Magno
-
Filipe Magno,
A planilha que eu uso é mais ou menos um lançamento de faturas de passagens aéreas. Ao final de cada mês eu preciso dividir as faturas de cada filial 001,002,003... tem várias faturas para cada filial. Eu criei uma macro que separa por filial, mas essa macro não atende muito a minha necessidade, porque as filiais mudam todo mês, então sempre preciso incluir mais alguma que não tinha no mês anterior.
O que eu procuro é uma macro que leia as filiais da coluna de filiais e separe em planilhas com os dados daquela filial. A planilha criada precisa estar tal e qual a planilha principal, porém somente com os dados de 1 filial. No caso se eu tenho 10 filiais diferentes, eu preciso que a macro crie 10 planilhas diferentes.
A exceção, é que em apenas 1 filial (que é 'não operacional'), eu preciso usar um segundo critério. O numero dessa filial é 009, então nessas filiais eu vou ter que usar um 2º critério de outra coluna. Atualmente eu tenho uma pasta que armazena somente as planilhas em que a filial é 009, porem elas são divididas pelo seu centro de custo (que é a coluna do 2º critério)
Ficou claro? :)
-
-
Olá, boa noite
Disponibilizei o arquivo
https://skydrive.live.com/redir?resid=7966CC7A7B60A648!313&authkey=!APgqFFfYzsiNWJs
Como disse, preciso que sejam criadas outras planilhas (cópia da original) baseadas na coluna [Projeto], porém, apenas com os dados que pertencem a esse projeto.
Ex.: Se o filtro da coluna for igual a: "Porto Velho" eu preciso criar uma copia da planilha, porém, apenas com os dados do projeto "Porto Velho".
A exceção é no caso do projeto "Não Operacional", pois nele, eu preciso fazer o filtro em outra coluna, que é a coluna [Centro de Custos] e dividir da mesma forma, porem em planilhas diferentes que serao baseadas nas informações da coluna centro de custo.
Ficou claro? :)
-
Duas dúvidas. Primeiro, a terminologia.
Tecnicamente falando, pasta de trabalho é um arquivo de Excel, e planilha, é uma aba dentro de uma pasta de trabalho. Você precisa que sejam criadas planilhas ou pastas de trabalho com os filtros?
Além disso, a rotina que você precisa cria automaticamente pastas de trabalho (ou planilhas) de todos os filtros possíveis ou terá a opção de criar somente de um específico que você escolher?
Felipe Costa Gualberto - http://www.ambienteoffice.com.br
-
Boa noite Lidiq!
Desculpe o sumiço, mas estive em viagem de trabalho nas últimas 2 semanas e não tive tempo de responder.
Mas acho que minha sugestão talvez lhe ajude. Primeiramente peço licença ao Felipe Costa Gualberto para usar seu código proposto acima, visto que a partir dele fica bem simples resolver o seu problema (se entendi bem o que você precisa). O código que proponho primeiramente gera o relatório em Abas (Planilhas) e em seguida exporta para Pastas de Trabalho (Arquivos). Sendo assim, segue minha sugestão:
Sub GerarRelatorio() ' ' Dim lngBD As Long Dim lngLast As Long Dim wksBD As Worksheet Dim wks As Worksheet Dim Ccod As String 'Coluna com os códigos Dim Ccod1 As String 'Coluna com os códigos Primários Dim Ccod2 As String 'Coluna com os códigos Secundários Dim Lini As Long 'Linha Incial Dim FilCusto As String 'Identificador de Centro de Custo (ao invés de Filial) Dim EndArq As String Dim NomeArq As String Dim TipoX As String Dim Atual As String Dim i As Integer Ccod1 = "L" 'Filiais Ccod2 = "J" 'Centro de Custo Lini = 5 'Após cabeçalho FilCusto = "999999 Não Operacional" '"999999" EndArq = ActiveWorkbook.Path 'Edite aqui TipoX = "xlsx" 'xls 'Edite aqui 'Set wksBD = ThisWorkbook.Sheets("Banco de Dados Geral Dez2012") Set wksBD = ThisWorkbook.ActiveSheet Application.ScreenUpdating = False With wksBD For lngBD = Lini To .Cells(.Rows.Count, "A").End(xlUp).Row Set wks = Nothing If CStr(.Cells(lngBD, Ccod1)) = FilCusto Then Ccod = Ccod2 Else Ccod = Ccod1 End If On Error Resume Next Set wks = ThisWorkbook.Sheets(CStr(.Cells(lngBD, Ccod))) On Error GoTo 0 If wks Is Nothing Then Set wks = ThisWorkbook.Sheets.Add wks.Name = CStr(.Cells(lngBD, Ccod)) wksBD.Rows(Lini - 1).Copy wks.Rows(1) End If lngLast = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row + 1 wksBD.Rows(lngBD).Copy wks.Rows(lngLast) Next lngBD End With For i = Sheets.Count To 1 Step -1 wksBD.Activate If Sheets(i).Name <> wksBD.Name Then Call Exportar(EndArq, Sheets(i).Name, TipoX, Sheets(i).Name) Next i Application.ScreenUpdating = False End Sub
Sub Exportar(xEnd, xNome, TipoX, xNomeAba) ' 'Exportas as Abas Criadas ' ' xEnd => Endereço para Salvar ' xNome => Nome para Salvar ' TipoX => xls ou xlsx ' xNomeAba => Nome da Aba Desejada On Error GoTo FimInesperado Application.ScreenUpdating = False EndSalvar = xEnd & "\" & xNome & "." & TipoX 'Endereço completo If TipoX = "xlsx" Then Formato = xlOpenXMLWorkbook Else Formato = xlNormal 'xlExcel8 'Copiando para nova pasta Sheets(xNomeAba).Select ActiveSheet.Move 'Renomeando Aba e Excluindo as demais (Caso existam) Excel.Application.DisplayAlerts = False 'Desabilitando o pedido de confirmação de exclusão For i = 2 To Sheets.Count Sheets(2).Delete 'Tem o Incoveniente de solicitar confirmação sempre que exclui uma aba Next i Excel.Application.DisplayAlerts = True 'Reabilitando o pedido de confirmação 'Salvando ActiveWorkbook.SaveAs Filename:=EndSalvar, _ FileFormat:=Formato, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False ActiveWorkbook.Close Fim: Application.ScreenUpdating = True 'Beep 'MsgBox "Arquivo Exportado!", , "Operação Concluída!" Exit Sub FimInesperado: Application.ScreenUpdating = True MsgBox "Arquivo NÃO Exportado!" & vbNewLine & Err.Description, vbCritical, "Operação Não Realizada!" End Sub
Deixo a seu critério criar uma interface para escolha dos nomes dos arquivos, locais para salvar ou características que possam ser alteradas ao longo do trabalho (como as colunas de interesse). Toda a seleção atual é feita no prórpio código.
Dessa forma atende?
Um abraço.
Filipe Magno
-
-
Filipe, bom dia,
Desculpe a demora!
Eu testei seu código no dia em que você disponibilizou, mas não deu muito certo. Se não me engano, ele abre tudo em abas (planilhas) e depois exporta para pastas de trabalho, correto?
Eu testei e não funcionou :/
-
"Na verdade o que preciso são "pastas de trabalho"
Tudo bem, a própria Microsoft escorrega um pouco na terminologia de pastas de trabalho e planilhas.
---
Tente o código abaixo:
Sub fMain() Dim lngBD As Long Dim lngLast As Long Dim wksBD As Worksheet Dim wks As Worksheet Dim strCaminho As String Dim wkb As Workbook Application.ScreenUpdating = False Set wksBD = ThisWorkbook.Sheets("Banco de Dados Geral Dez2012") With wksBD For lngBD = 5 To .Cells(.Rows.Count, "L").End(xlUp).Row Set wks = Nothing On Error Resume Next Set wks = Workbooks(.Cells(lngBD, "L") & ".xlsx").Worksheets(1) On Error GoTo 0 If wks Is Nothing Then Set wks = Workbooks.Add(xlWBATWorksheet).Worksheets(1) strCaminho = Environ("temp") & "\" & .Cells(lngBD, "L") & ".xlsx" Kill strCaminho wks.Parent.SaveAs strCaminho _ , FileFormat:=xlOpenXMLWorkbook wksBD.Rows(1).Resize(4).Copy wks.Rows(1) wksBD.Rows(1).Columns.Copy wks.Columns.PasteSpecial xlPasteColumnWidths End If lngLast = wks.Cells(wks.Rows.Count, "L").End(xlUp).Row + 1 wksBD.Rows(lngBD).Copy wks.Rows(lngLast) DoEvents Next lngBD End With For Each wkb In Workbooks If wkb.Name <> ThisWorkbook.Name Then Application.Goto wkb.Worksheets(1).Range("A1") wkb.Close SaveChanges:=True End If Next wkb MsgBox "Pastas de trabalho salvas em: " & Environ("temp"), vbInformation Application.ScreenUpdating = True End Sub
Felipe Costa Gualberto - http://www.ambienteoffice.com.br
-
Filipe, bom dia,
Desculpe a demora!
Eu testei seu código no dia em que você disponibilizou, mas não deu muito certo. Se não me engano, ele abre tudo em abas (planilhas) e depois exporta para pastas de trabalho, correto?
Eu testei e não funcionou :/
Boa noite Lidiq.
A ideia do cógido é essa mesmo: gerar tudo primeiro em abas e em seguida exportar uma a uma para pastas de trabalho individuais.
Você poderia descrever melhor onde ocorreu o erro, em qual linha a execução foi interrompida?
Antes disso, você editou o código de acordo com suas necessidades? Exemplo: se você usar o Excel 2003, você necessariamente terá que alterar a linha:
TipoX = "xlsx" 'xls 'Edite aqui
para
TipoX = "xls" 'Edite aqui
Outro detalhe diz respeito às colunas de interesse, que podem ter sido alteradas...
Se puder, explique melhor o erro.
Um abraço.
Filipe Magno
-
-
-
-
Filipe,
Sim, eu fiz as alterações. No caso, a planilha não estava puxando o cabeçalho e também, ao exportar, pedia sempre para escolher uma planilha pra atualizar. Acredito que foi esse o erro.
Boa noite Lidiq!
Pra garantir que não foi nenhuma modificação minha na sua palnilha, baixei novamente do skydrive, salvei como xlsm e copiei o código que postei aqui para um módulo novo. Nesse teste não ocorreu nenhum erro e nenhuma mensagem solicitando atualização! Por isso te pergunto:
- Na sua planilha original possui mais dados além dos que você disponibilizou?
- Você poderia repetir o teste que citei para ver se consegue o mesmo resultado?
Vlw.
Filipe Magno
-
Filipe,
Desculpa pelo atraso! Ultimamente tô muito ocupada, mas voltei a focar nessa planilha mais do que nunca!
Eu baixei novamente o arquivo que disponibilizei no Skydrive, copiei seu código, o tipo é .xlsx mesmo e tirei a instrução Kill.
A macro até rodou, mas só funcionou para 2 filiais e em seguida travou e reiniciou o excel.
Tentei alterar o local para salvar as pastas de trabalho que serão geradas, mas também deu erro :/
Também não queria nomear 1 só planilha (aba)
Ex.:
Set wksBD = ThisWorkbook.Sheets("Banco de Dados Geral Dez2012")
O ideal é que a planilha (aba), fosse a que está ativada, tipo "ActiveSheet", ou algo do tipo.
Obrigada! :)
-
-
Filipe,
Desculpa pelo atraso! Ultimamente tô muito ocupada, mas voltei a focar nessa planilha mais do que nunca!
Eu baixei novamente o arquivo que disponibilizei no Skydrive, copiei seu código, o tipo é .xlsx mesmo e tirei a instrução Kill.
A macro até rodou, mas só funcionou para 2 filiais e em seguida travou e reiniciou o excel.
Tentei alterar o local para salvar as pastas de trabalho que serão geradas, mas também deu erro :/
Também não queria nomear 1 só planilha (aba)
Ex.:
Set wksBD = ThisWorkbook.Sheets("Banco de Dados Geral Dez2012")
O ideal é que a planilha (aba), fosse a que está ativada, tipo "ActiveSheet", ou algo do tipo.
Obrigada! :)
Boa noite Lidiq!
Acho que vc se confundiu e misturou as respostas minhas (Filipe) com as do Benzadeus (Felipe). O código que sugeri foi:
Sub GerarRelatorio() ' ' Dim lngBD As Long Dim lngLast As Long Dim wksBD As Worksheet Dim wks As Worksheet Dim Ccod As String 'Coluna com os códigos Dim Ccod1 As String 'Coluna com os códigos Primários Dim Ccod2 As String 'Coluna com os códigos Secundários Dim Lini As Long 'Linha Incial Dim FilCusto As String 'Identificador de Centro de Custo (ao invés de Filial) Dim EndArq As String Dim NomeArq As String Dim TipoX As String Dim Atual As String Dim i As Integer Ccod1 = "L" 'Filiais Ccod2 = "J" 'Centro de Custo Lini = 5 'Após cabeçalho FilCusto = "999999 Não Operacional" '"999999" EndArq = ActiveWorkbook.Path 'Edite aqui TipoX = "xlsx" 'xls 'Edite aqui 'Set wksBD = ThisWorkbook.Sheets("Banco de Dados Geral Dez2012") Set wksBD = ThisWorkbook.ActiveSheet Application.ScreenUpdating = False With wksBD For lngBD = Lini To .Cells(.Rows.Count, "A").End(xlUp).Row Set wks = Nothing If CStr(.Cells(lngBD, Ccod1)) = FilCusto Then Ccod = Ccod2 Else Ccod = Ccod1 End If On Error Resume Next Set wks = ThisWorkbook.Sheets(CStr(.Cells(lngBD, Ccod))) On Error GoTo 0 If wks Is Nothing Then Set wks = ThisWorkbook.Sheets.Add wks.Name = CStr(.Cells(lngBD, Ccod)) wksBD.Rows(Lini - 1).Copy wks.Rows(1) End If lngLast = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row + 1 wksBD.Rows(lngBD).Copy wks.Rows(lngLast) Next lngBD End With For i = Sheets.Count To 1 Step -1 wksBD.Activate If Sheets(i).Name <> wksBD.Name Then Call Exportar(EndArq, Sheets(i).Name, TipoX, Sheets(i).Name) Next i Application.ScreenUpdating = False End Sub
Sub Exportar(xEnd, xNome, TipoX, xNomeAba) ' 'Exportas as Abas Criadas ' ' xEnd => Endereço para Salvar ' xNome => Nome para Salvar ' TipoX => xls ou xlsx ' xNomeAba => Nome da Aba Desejada On Error GoTo FimInesperado Application.ScreenUpdating = False EndSalvar = xEnd & "\" & xNome & "." & TipoX 'Endereço completo If TipoX = "xlsx" Then Formato = xlOpenXMLWorkbook Else Formato = xlNormal 'xlExcel8 'Copiando para nova pasta Sheets(xNomeAba).Select ActiveSheet.Move 'Renomeando Aba e Excluindo as demais (Caso existam) Excel.Application.DisplayAlerts = False 'Desabilitando o pedido de confirmação de exclusão For i = 2 To Sheets.Count Sheets(2).Delete 'Tem o Incoveniente de solicitar confirmação sempre que exclui uma aba Next i Excel.Application.DisplayAlerts = True 'Reabilitando o pedido de confirmação 'Salvando ActiveWorkbook.SaveAs Filename:=EndSalvar, _ FileFormat:=Formato, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False ActiveWorkbook.Close Fim: Application.ScreenUpdating = True 'Beep 'MsgBox "Arquivo Exportado!", , "Operação Concluída!" Exit Sub FimInesperado: Application.ScreenUpdating = True MsgBox "Arquivo NÃO Exportado!" & vbNewLine & Err.Description, vbCritical, "Operação Não Realizada!" End Sub
Um abraço!
Filipe Magno
-
Filipe Magno,
Oi, desculpa pela confusão que fiz, rsrsrs
Enfim, vim informar que deu suuuuuper certo :D obrigada mesmo!
Só queria perguntar mais uma coisinha... tem como salvar as filiais em um endereço e as '999999' em um endereço diferente?
-
Felicidade de pobre dura pouco :/
Essa planilha que disponibilizei é uma cópia mais enxuta do arquivo, porque o arquivo original tem dados pessoais de várias pessoas. Então quando fui rodar a planilha original, ela deu um erro nessa linha:
On Error Resume Next Set wks = ThisWorkbook.Sheets(CStr(.Cells(lngBD, Ccod))) On Error GoTo 0 If wks Is Nothing Then Set wks = ThisWorkbook.Sheets.Add >>>>> wks.Name = CStr(.Cells(lngBD, Ccod)) <<<<<<<<<<< wksBD.Rows(Lini - 1).Copy wks.Rows(1)
-
Olá!
esse erro ocorreu provavelmente porque o código está executando em uma aba que possui formatação diferente da aba que possui os cadastros e a variável "lngBD" assumiu um valor inválido para nomear a nova aba criada. Se for isso (vc pode conferir verificando o valor atribuído à variável no momento do erro, clicando em "Depurar" e passando o mouse sobre a variável), vc deve criar uma condição que ignore a exportação dessa aba (isso pode ser feito de várias maneiras, como usar o "Nome" da Aba - não aconselho -, usar o "CodName" da aba - boa saída! - ou a posição da aba - não aconselho - ou ainda outra).
Veja se é isso.
Um abraço.
Filipe Magno
-
Filipe,
É tipo como se ela tivesse recebendo o valor da linha vazia, pq ela começa a dar erro quando vai criar a 'aba 29' e no caso, ela recebe o valor da linha 283 e essa linha é a primeira linha vazia, então, não tem como nomear com um valor vazio.
Tô tentando resolver aqui
-
-
-
Olá!
Vc precisa ser mais específica! Antes estava funcionando certinho. Daí vc incluiu uma aba que não possui a mesma configuração e deu erro. Então vc consertou e parou de exportar. Fica difícil imaginar o que vc alterou e o tipo de erro que está dando.
Vlw.
Filipe Magno
-
Liqid, estou um pouco perdido neste tópico. Qual solução você adotou, minha ou do Filipe? Se está seguindo a minha, experimentou retirar a linha da instrução Kill e tentou executar o código novamente?
Felipe Costa Gualberto - http://www.ambienteoffice.com.br
-
-
Na verdade o que aconteceu é que a planilha original tem fórmulas, então criei uma macro q copiasse o valor sem fórmulas para outra planilha e em seguida fizesse o filtro. Ela tava dando erro pq a "aba 29" corresponde a uma linha vazia (que só tinha o código), então quando eu passei pra outra planilha que está sem formulas, o código fez todo o filtro, as abas foram criadas, mas não foram exportadas. A unica alteração que fiz, foi chamar a macro.
-
Boa noite Lidiq.
A função Exportar que te passei é uma função "genérica", ou seja, não precisa de nenhuma formatação especial para funcionar. Ele funciona em qualquer pasta de trabalho.
Como a geração das abas está funcionando, o único lugar que consigo pensar que poderia gerar erro é na linha a seguir:
For i = Sheets.Count To 1 Step -1 wksBD.Activate If Sheets(i).Name <> wksBD.Name Then Call Exportar(EndArq, Sheets(i).Name, TipoX, Sheets(i).Name) Next i
Ou ainda, caso sua pasta de trabalho não tenha sido salva ainda (nenhuma vez), suas abas podem estar sendo exportadas para uma pasta temporária, por causa da linha a seguir:
EndArq = ActiveWorkbook.Path
De qualquer forma, vc precisa descrever melhor o que está dando errado, para que eu possa tentar te ajudar melhor.
Um abraço.
Filipe Magno
-
Filipe,
Não aparece nenhum erro no código. Ele gera todas as abas, mas não exporta.
Antes, as células vazias estavam com fórmulas, e elas ficavam com esse valor ('), então tava dando erro na hora de nomear a aba e aí o código parava. Agora ele roda completo, gera tudo, mas não exporta.
-
Filipe,
Boas notícias! O código rodou sem erros e exportou os resultados :)
Só queria saber se você pode me ajudar a fazer algumas alterações.
1º. a planilha(pasta de trabalho) tem várias abas(planilhas)... ela exportou todas as abas e deixou apenas a que estava ativa. O ideal seria que exportasse apenas as que foram criadas através do filtro
2º. como posso fazer para colocar as filiais 999999 em um endereço diferente? (pasta separada)
obrigada!
-
Boa noite Lidiq!
Alterei o código para sua necessidade:
Sub GerarRelatorio() ' ' Dim lngBD As Long Dim lngLast As Long Dim wksBD As Worksheet Dim wks As Worksheet Dim Ccod As String 'Coluna com os códigos Dim Ccod1 As String 'Coluna com os códigos Primários Dim Ccod2 As String 'Coluna com os códigos Secundários Dim Lini As Long 'Linha Incial da Planilha principal Dim LiniAbas As Long 'Linha Incial das Abas a Exportar Dim FilCusto As String 'Identificador de Centro de Custo (ao invés de Filial) Dim EndArq As String Dim EndArq1 As String Dim EndArq2 As String Dim NomeArq As String Dim TipoX As String Dim Atual As String Dim i As Integer Dim nSh As Integer 'Dados de Configuração: '>> Ccod1 = "L" 'Filiais Ccod2 = "J" 'Centro de Custo Lini = 5 'Após cabeçalho na Planilha principal LiniAbas = 2 'Após cabeçalho nas Abas a Exportar FilCusto = "999999 Não Operacional" '"999999" EndArq1 = ActiveWorkbook.Path 'Edite aqui EndArq2 = ActiveWorkbook.Path & "\Não Operacional" 'Edite aqui TipoX = "xlsx" 'xls 'Edite aqui '<< Set wksBD = ThisWorkbook.ActiveSheet Application.ScreenUpdating = False nSh = Sheets.Count 'ActiveSheet.Index 'Para não exportar as abas já existentes! With wksBD For lngBD = Lini To 7 '.Cells(.Rows.Count, "A").End(xlUp).Row Set wks = Nothing If CStr(.Cells(lngBD, Ccod1)) = FilCusto Then Ccod = Ccod2 Else Ccod = Ccod1 End If On Error Resume Next Set wks = ThisWorkbook.Sheets(CStr(.Cells(lngBD, Ccod))) On Error GoTo 0 If wks Is Nothing Then ThisWorkbook.Sheets.Add Before:=Sheets(1) Set wks = ActiveSheet wks.Name = CStr(.Cells(lngBD, Ccod)) wksBD.Rows(Lini - 1).Copy wks.Rows(1) End If lngLast = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row + 1 wksBD.Rows(lngBD).Copy wks.Rows(lngLast) Next lngBD End With For i = Sheets.Count - nSh To 1 Step -1 'wksBD.Activate If Sheets(i).Range(Ccod1 & LiniAbas) <> FilCusto Then EndArq = EndArq1 'Pasta Padrão Else EndArq = EndArq2 'Pasta Especial End If Call Exportar(EndArq, Sheets(i).Name, TipoX, Sheets(i).Name) Next i Application.ScreenUpdating = False End Sub
Você precisa apenas definir um diretório existente para a variável "EndArq". No caso acima, eu indiquei a subpasta "Não Operacional", que fica dentro da pasta que a planilha está salva e já existia anteriormente.
Você pode alterar livremente. A função "Exportar" não se altera.
Ok?
Filipe Magno
-
Filipe,
Desculpa, pode ser falta de atenção minha, não sei... mas eu peguei o código, substitui aqui no meu, não alterei a função 'Exportar', fiz as alterações necessárias e na hora de executar simplesmente não foi.
Sei que já tô folgada demais, mas você sabe dizer se é algo desabilitado ou alguma configuração no excel? Essa pasta de trabalho é a mesma que usei nos outros testes, achei estranho.
Obrigada por ter feito as alterações! :)
-
Boa noite Lidiq!
Não precisa pedir desculpas, isso é muito normal de acontecer. Às vezes a solução está na nossa frente e não conseguimos ver.
Mas voltando ao seu problema, fica um pouco difícil imaginar o que pode ser o seu problema sem ter o arquivo em mãos, mas aí vão alguns testes/dicas pra vc tentar descobrir:
- Qual erro aparece quando vc executa? As abas são geradas?
- Você Habilitou a Execução de Macros ao abrir o arquivo (ou mudou as configurações de segurança para não executar macros)?
- Você utiliza um botão para chamar o código? Se sim, entre no VBA e aperte F5 com o cursor dentro da função principal.
- Vc não tinha alterado anteriormente o código? Se sim reveja com cuidado o que precisa ser alterado.
Não consigo imaginar nada diferente. Tente detalhar melhor o erro ou disponibilize sua pasta de trabalho.
Espero que encontre o erro.
Filipe Magno
-
-
Boa tarde Lidiq!
Mil desculpas, o erro foi meu. Substitua a linha:
For lngBD = Lini To 7 '.Cells(.Rows.Count, "A").End(xlUp).Row
por:
For lngBD = Lini To .Cells(.Rows.Count, "A").End(xlUp).Row
Eu tinha colocado o número 7 pra não precisar gerar a lista inteira, apenas no momento dos testes, mas me esqueci de apagar!
Aproveitando, troque o n° 8 a seguir por 2 (as abas tem seu cabeçalho na linha 1):
LiniAbas = 2 '8 'Após cabeçalho nas Abas a Exportar
ou copie o logo também para as abas, substituindo:
wksBD.Rows(Lini - 1).Copy wks.Rows(1)
por
wksBD.Rows("1:" & Lini - 1).Copy wks.Rows(1)
Espero que dessa forma funcione!
Um abraço.
Filipe Magno
- Marcado como Resposta Lidiq terça-feira, 18 de junho de 2013 20:29
-
-
Lidiq,
fico feliz em saber que funcionou. Aproveito e agradeço ao Benzadeus pela base do código.
Sobre as filiais, verifique a linha:
FilCusto = "999999 Não Operacional" '"999999"
Se não me engano, no seu código original não constava a parte "Não Operacional". Ou ainda se o endereço que você indicou existe (não inclui a criação do diretório caso ele não exista). Em princípio, essa parte está operacional.
Ao final, lembre de indicar a(s) resposta(s) que te atenderam, para facilitar a organização do fórum, já que o tópico ficou bastante extenso.
Um grande abraço.
Filipe Magno
-
-
Bom dia,
Estou com outra dúvida em relação à planilha, devo abrir outro tópico ou continuar esse?
É em relação a um 'valor total', a última linha da aba, que precisa ir nos filtros. E ela também está copiando as outras abas com fórmulas ;/
Obrigada!
-
Boa tarde Lidiq!
Na minha opinião, como a resposta para esse tópico já foi escolhida, o ideal é abri um novo tópico e colocar o link para esse. Assim fica mais fácil organizar o fórum.
Aproveitando, não entendi bem sua questão:
- "...um 'valor total', a última linha da aba, que precisa ir nos filtros" --> você quer que ao finalizar as abas seja feita uma totalização dos valores? Se for, quais valores?
- "E ela também está copiando as outras abas com fórmulas" --> Não entendi essa parte.
Um abraço!
Filipe Magno
- "...um 'valor total', a última linha da aba, que precisa ir nos filtros" --> você quer que ao finalizar as abas seja feita uma totalização dos valores? Se for, quais valores?
-
Olá cara estou utilizando essa macro q vc citou ... porém tem como ajustar ela pra copiar um certo conteudo da planilha da mesma forma q copia apenas o cabeçalho ... porém seriam mais linhas e mais colunas ... e outra coisa em um determinado campo tem como puxar o nome da guia atomaticamente ... pois vou criar varias guias com um determinado codigo ... e depois vou ter q lancar este codigo na planilha pra poder buscar o nome do item ao qual o codigo se refere ... valew obrigado
-
Olá Filipe, tudo bem?
Eu sei que esse post é um pouco antigo
Mas eu tenho a esperança que você possa me ajudar
Eu estou exatamente com o mesmo problema que foi relatado nesse post
Porém eu copiei e colei o código no VBA da minha planilha e deu um erro de "SUB OU FUNCTION NÃO DEFINIDOS"
Você poderia me ajudar por favor?
-
Boa tarde leandroferrari87.
Como você mesmo disse, este post é muito antigo e já está fechado, além de muito extenso (quase 50 respostas). Sugiro então que abra um novo tópico e cole nele o link para este, além dos códigos que está utilizando, facilitando a organização do fórum.
Aproveito para pedir que insira mais detalhes do erro, indicando em que linha ele ocorre.
Filipe Magno