Excel Unitizar dados duplicados do Excel exportando para outra aba

[Élcio Alves da Silva]

Bom dia a todos os membros.

Preciso de ajuda sobre como separar apenas os dados duplicados na planilha de Excel e exportar para outra planilha, conforme anexo.

Na aba faturamento tenho NF do mesmo cliente e quero unitizar para outra planilha, em destacado por cliente, sou leigo no Excel e não consegui montar de forma automática.

 

Desde já agradeço.

Unitizar.xlsx

[André_Arruda]

Inseri uma formatação condicional por cor pra toda vez que o cliente estiver repetido. 

sendo assim basta filtrar "por cor" no menu de filtro.

 

ai copia os dados e cola onde quiser

 

Unitizar.xlsx

[Élcio Alves da Silva]

Obrigado pela resposta, mas dessa forma não ajuda, na condicional vai destacar todos clientes na mesma cor, teria que ser da forma da planilha em anexo.

[Visitante]

Se você quiser experimentar uma solução via macro então instale uma cópia do código abaixo em um módulo comum, assim:
1. copie o código daqui
2. a partir da planilha em que estão os dados tecle Alt+F11 para acessar o editor de VBA
3. no menu do editor / Inserir / Módulo
4. cole o código na janela em branco que vai se abrir
5. feito! Alt+Q para retornar para a planilha e testar

para rodar o código:
6. tecle Alt+F8 / selecione a macro correspondente / Executar, ou insira um botão na planilha e vincule-o à macro ou vincule-a a um atalho de teclado (Alt+F8 / Opções).

Sub ExtraiNFsDuplicadas()
 Dim LR As Long
  LR = Cells(Rows.Count, 1).End(3).Row
  Application.ScreenUpdating = False
  [D:F] = ""
  Range("A1:A" & LR).Copy [E1]
  Range("B1:B" & LR).Copy [D1]
  Range("F2:F" & LR).Value = "=COUNTIF(D$2:D$" & LR & ",D2)"
  [D1:F1].AutoFilter 3, 1 '"=" & 1
  Range("D2:E" & LR).Value = ""
  ActiveSheet.AutoFilterMode = False
  Range("D2:E" & LR).Sort Key1:=[D2], Order1:=xlAscending
  [F:F] = ""
  Application.ScreenUpdating = True
End Sub

obs.

1. o resultado será colocado na mesma planilha a partir de D1

2. no seu resultado faltou o registro

[Élcio Alves da Silva]

Boa tarde, a macro funcionou, agora só falta destacar os clientes e separar por cor, tipo tabela, vela imagem abaixo.

 

Obrigado por enquanto.

 

 

[André_Arruda]

pegando carona no código do amigo Osvaldo, insira isso para colorir:

basta apagar a ultima linha (  Application.ScreenUpdating = True) do codigo dele e inseri no lugar o codigo abaixo:

 

 

 

 'colorir
  For Each celula In Range("D2:D" & LR)
    
    Select Case celula.Value
        Case Is = ""
        Resume Next
        
        Case Is <> ""
    
            If celula.Value <> celula.Offset(-1, 0).Value Then
                If celula.Offset(-1, 0).Interior.ColorIndex = 15 Then
                    celula.Interior.ColorIndex = 36
                    celula.Offset(0, 1).Interior.ColorIndex = 36
                Else
                    celula.Interior.ColorIndex = 15
                    celula.Offset(0, 1).Interior.ColorIndex = 15
                End If
            End If
            
            If celula.Value = celula.Offset(-1, 0).Value Then
                celula.Interior.ColorIndex = celula.Offset(-1, 0).Interior.ColorIndex
                celula.Offset(0, 1).Interior.ColorIndex = celula.Offset(-1, 0).Interior.ColorIndex
            End If
    End Select
  Next
  Application.ScreenUpdating = True

 

Unitizar.rar

[Visitante]

Sub ExtraiNFsDuplicadasV2()
 Dim LR As Long, k As Long, v As Long, b As Boolean
  LR = Cells(Rows.Count, 1).End(3).Row
  Application.ScreenUpdating = False
  Range("D:F").Clear
  Range("A1:A" & LR).Copy [E1]
  Range("B1:B" & LR).Copy [D1]
  Range("F2:F" & LR).Value = "=COUNTIF(D$2:D$" & LR & ",D2)"
  [D1:F1].AutoFilter 3, 1 '"=" & 1
  Range("D2:E" & LR).Value = ""
  ActiveSheet.AutoFilterMode = False
  Range("D2:E" & LR).Sort Key1:=[D2], Order1:=xlAscending
  [F:F] = "": Range("D" & Cells(Rows.Count, 4).End(3).Row + 1 & ":E" & LR).Clear
  For k = 2 To Cells(Rows.Count, 4).End(3).Row
   v = Application.CountIf([D:D], Cells(k, 4))
   If b Then Cells(k, 4).Resize(v, 2).Interior.ColorIndex = 24
   b = Not b: k = k + v - 1
  Next k
  Application.ScreenUpdating = True
End Sub

 

[Élcio Alves da Silva]

Obrigado mestre, Rodou direitinho