none
Criar novas planilhas a partir do filtro de uma coluna RRS feed

  • 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.

    :)

    sexta-feira, 5 de abril de 2013 10:21

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
    quinta-feira, 6 de junho de 2013 15:32

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

    sexta-feira, 5 de abril de 2013 22:49
    Moderador
  • 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:

    1. 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...".
    2. 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

    sábado, 6 de abril de 2013 02:33
  • 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?

    terça-feira, 9 de abril de 2013 00:42
  • FilipeMagno,


    Eu tentei seguir suas instruções, mas não achei a opção... uso o Excel 2010.

    terça-feira, 9 de abril de 2013 00:42
  • 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

    terça-feira, 9 de abril de 2013 03:30
  • 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? :)

    quarta-feira, 10 de abril de 2013 00:27
  • Estou tendo dificuldades para entender a estrutura da sua planilha. Poderia disponibilizá-la para análise?

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 10 de abril de 2013 01:29
    Moderador
  • 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? :)

    quinta-feira, 18 de abril de 2013 01:37
  • 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

    sábado, 20 de abril de 2013 14:08
    Moderador
  • 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

    domingo, 21 de abril de 2013 23:10
  • Bom dia, Benzadeus,

    Desculpa a demora!

    Na verdade o que preciso são "pastas de trabalho". É que eu pensei que se me referisse dessa forma, iria confundir, rs

    sexta-feira, 3 de maio de 2013 10:13
  • 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 :/

    sexta-feira, 3 de maio de 2013 10:15
  • "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

    sábado, 4 de maio de 2013 13:03
    Moderador
  • 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

    domingo, 5 de maio de 2013 03:07
  • Benzadeus,

    Testei o código e ele estava dando erro em 

     strCaminho = Environ("temp") & "\" & .Cells(lngBD, "L") & ".xlsx"
                    Kill strCaminho

    Ele sempre abre uma planilha vazia. 

    quarta-feira, 8 de maio de 2013 10:12
  • 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.

    quarta-feira, 8 de maio de 2013 10:14
  • Elimine a linha da instrução Kill

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 8 de maio de 2013 23:57
    Moderador
  • 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:

    1. Na sua planilha original possui mais dados além dos que você disponibilizou?
    2. Você poderia repetir o teste que citei para ver se consegue o mesmo resultado?

    Vlw.


    Filipe Magno

    sexta-feira, 10 de maio de 2013 03:47
  • 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! :)

    quarta-feira, 22 de maio de 2013 21:06
  • Ah, também gostaria de incluir....

    O código que for disponibilizado vai ser utilizado também em outras pastas de trabalho :/ é o mesmo sentido:

    fazer filtros e separar em pastas de trabalhos, a única coisa que muda é a coluna.  :)

    quarta-feira, 22 de maio de 2013 21:08
  • 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

    quarta-feira, 22 de maio de 2013 22:44
  • 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?

    quinta-feira, 23 de maio de 2013 11:53
  • 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)

    quinta-feira, 23 de maio de 2013 12:11
  • 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

    quinta-feira, 23 de maio de 2013 13:52
  • 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

    quinta-feira, 23 de maio de 2013 14:30
  • Agora ela criou todas, mas não exportou :((((((((((((((((((((((
    quinta-feira, 23 de maio de 2013 15:10
  • Oi, alguém poderia me ajudar?
    segunda-feira, 27 de maio de 2013 19:54
  • 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

    segunda-feira, 27 de maio de 2013 23:25
  • 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

    terça-feira, 28 de maio de 2013 22:15
    Moderador
  • Estou usando a do FilipeMagno ;)
    sexta-feira, 31 de maio de 2013 19:17
  • 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.

    sexta-feira, 31 de maio de 2013 19:23
  • 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

    sexta-feira, 31 de maio de 2013 23:25
  • 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.

    segunda-feira, 3 de junho de 2013 19:36
  • 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!

    terça-feira, 4 de junho de 2013 21:02
  • 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

    quarta-feira, 5 de junho de 2013 00:59
  • 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! :)

    quarta-feira, 5 de junho de 2013 20:58
  • 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:

    1. Qual erro aparece quando vc executa? As abas são geradas?
    2. Você Habilitou a Execução de Macros ao abrir o arquivo (ou mudou as configurações de segurança para não executar macros)?
    3. 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.
    4. 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

    quarta-feira, 5 de junho de 2013 23:33
  • Filipe, 

    Não alterei, as macros estão habilitadas e eu uso F5 mesmo...

    https://skydrive.live.com/redir?resid=7966CC7A7B60A648!315&authkey=!AOpNKZFQAbW_5CA


    quinta-feira, 6 de junho de 2013 13:57
  • 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
    quinta-feira, 6 de junho de 2013 15:32
  • Filipe,

    deu suuuuper certo! Ficou bonitinho :) o único probleminha que ficou é que as Filiais 999999 não ficaram na pasta separada, mas isso é o de menos. Muuuito obg!

    Abraço!

    sexta-feira, 7 de junho de 2013 14:33
  • 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

    sexta-feira, 7 de junho de 2013 15:24
  • Filipe,

    tá como '999999' mesmo. Elas são exportadas, mas vão junto com as outras e não pro caminho especificado.

    sexta-feira, 7 de junho de 2013 18:47
  • 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!

    sexta-feira, 28 de junho de 2013 13:44
  • 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

    sábado, 29 de junho de 2013 17:44
  • 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
    terça-feira, 9 de julho de 2013 18:24
  • 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?

    sexta-feira, 12 de janeiro de 2018 23:31
  • 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.

    Aguardo.


    Filipe Magno

    sábado, 13 de janeiro de 2018 19:03