Macro para separar nomes por aba

Question

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 reais

8/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á

Answer 1

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

Answer 2

Boa tarde Filipe Magno, olha não tentei, alias nem passou por minha cabeça isso, vou tentar depois posto o resultado e obrigado pela dica.

Answer 3

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.

Answer 4

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