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,