Ir ao conteúdo
  • Cadastre-se

RONALDO_FLASH

Membro Júnior
  • Posts

    1
  • Cadastrado em

  • Última visita

Reputação

0
  1. olá pessoal, bem?? estou com uma duvida em um código VBA e preciso da ajuda de vocês. tenho o seguinte código: 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 = "A" 'Filiais Ccod2 = "J" 'Centro de Custo Lini = 2 'Após cabeçalho na Planilha principal LiniAbas = 2 'Após cabeçalho nas Abas a Exportar 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 .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 esse código pega da minha sheet principal todos os registros de cada grupo e vai criando uma nova sheet para cada grupo.. é exatamente o que preciso, porém, preciso que a cada sheet que é criada, seja salva em uma nova pasta de Excel..(Excel novo) em uma pasta em minha desktop.... porém, essa parte de salvar o resultado q não está ok. ele cria as sheets porém sem exportar o resultado e salvar na pasta q preciso (veja acima na parte Call Exportar) . Como copiei aqui do fórum esse código, talvez esteja esquecendo de algo. Outra dúvida, esse meu arquivo contem muitos registros, ceca de 360mil linhas... e preciso separar por grupos como já está fazendo, são mais ou menos 350 grupos.. é possível pelo VBA ? o Excel suporta esse tanto de sheet e esse código? como teste, fiz um uma planilha separada apenas alguns dos grupos... O código funciona quando comento a parte do (Call Exportar) porém, ele criar as sheets corretamente, mas não exporta... que a parte que preciso.. valeu galera... e tomara q consigam me ajudar.... abs,

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Ebook grátis: Aprenda a ler resistores e capacitores!

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!