Inquiridor
Macro para separar nomes por aba

Pergunta
-
Boa tarde galera tudo bem ?
Tenho uma planilha onde na aba SHEET1, coluna A tem a data de carregamento da carga, coluna B coluna de descarregamento da carga, coluna C local de carregamento, coluna D quantas cargars, coluna E cocal de descarregamento, coluna F quanto descarregou, coluna G Nome do motorista, Coluna H numero da placa do caminhão, Coluna I Nome da empresa onde vai descarregar, e por ultimo coluna J valor da carga.
A B C D E F G H I J
8/1 8/2 SP 10 RJ 10 Paulo 0000 empresa 1 1000 reais8/1 8/4 SC 5 MT 5 Jorge 1111 empresa 2 500 reais
existem mais de 70 motoristas na emresa, e cada um vai para um local, ou as vezes todos para o mesmo local, tentei fazer uma macro onde ele copia se baseando pela empresa, ou seja todos que foram para a empresa 1 crie uma aba com o nome empresa 1, filtre todos os que foram nela e cole esse resultado.Se existir 10 empresa, crie 10 abas com seus respectivos nomes filtre e cole esses resultados.
eu ate consegui farzer a macro para colar em abas diferente, porem como todos os dias são inseridos dados novos na aba SHEET1 então, toda vez que eu ativo a macro ela copia todos os dados, inclusive os que já foram inseridos da primeira vez, assim sendo fica em dados duplicados.
abaixo está a macro que eu usei
Sub ReplicaDadosFiltrados()
Dim c As Range, wsO As Worksheet, wsD As Worksheet
Application.ScreenUpdating = False
Set wsO = Sheets("Sheet1")
wsO.AutoFilterMode = False: wsO.[S:S] = ""
Range("I2:I" & Cells(Rows.Count, 9).End(3).Row).Copy [S2]
[S:S].RemoveDuplicates Columns:=1, Header:=xlNo
For Each c In Range("S2:S" & Cells(Rows.Count, 19).End(3).Row)
wsO.Range("A1:N" & wsO.Cells(Rows.Count, 1).End(xlUp).Row).AutoFilter 9, c.Value
On Error Resume Next
Set wsD = Sheets(c.Value)
If Err.Number = 9 Then
Worksheets.Add(after:=Sheets(Sheets.Count)).Name = c.Value
Err.Clear
Set wsD = ActiveSheet
wsO.Range("A1:O1").Copy wsD.Range("A1")
wsO.Range("A2:O" & wsO.Cells(Rows.Count, 1).End(xlUp).Row).Copy wsD.[A2]
Else
Set wsD = Sheets(c.Value)
wsO.Range("A2:O" & wsO.Cells(Rows.Count, 1).End(xlUp).Row).Copy wsD.Cells(Rows.Count, 1).End(3)(2)
End If
wsO.AutoFilterMode = False
Next c
wsO.[S:S] = ""
Application.ScreenUpdating = True
End Sub
Obrigado desde já
Todas as Respostas
-
Já tentou a abordagem por Tabela Dinâmica? Com ela este e outros inúmeros problemas simplesmente deixam de existir e você passa a ter o controle real sobre o seus dados, com um mínimo de esforço.
E aproveitando o assunto, sugiro também que os dados da "Sheet1" sejam inseridos dentro de uma "Tabela" (Inserir >> Tabela). Facilita muito a utilização, inclusive para gerar as Tabelas Dinâmicas.
Abraço.
Filipe Magno
-
-
Boa tarde Filipe Magno, bom tentei a Tabela Dinâmica ficou bom para mim ver, mas a maioria do pessoal não tem boa noção do excel então não colou muito bem, no momento estou usando para mim, mas vou tentar fazer uma macro que simplifique isso, bom obrigado pela dica.
-
Olá, bom dia!
Uma informação importante sobre Tabelas Dinâmicas que poucos sabem, e talvez lhe seja útil, é que ela também faz automaticamente a separação de dados em abas, da forma que você citou. Para isto, basta colocar no campo de página o critério que deseja (no seu caso o campo "Empresa") e em seguida ir em "Opções >> Opções >> Mostrar Páginas do Filtro de Relatório...". Será gerada automaticamente uma Aba para cada "Empresa" (no seu caso) vinculada à sua base de dados, ou seja, todas as abas permanecerão sincronizadas (atualizando uma todas são atualizadas).
Abraço.
Filipe Magno