PERCORRER COLUNA DE DADOS E COPIAR DADOS PARA UMA NOVA PLANILHA

Question

Por favor, preciso de ajuda.

Preciso de um codigo que percorra uma coluna (B) que terão diferentes nomes, porem estes nomes se repetem. Por exemplo:

Vini
Vini
Joao
Jose
Jose
Jose

Os nomes só se repetem quando agrupados. Não há chance de aparecer um Vini depois de Jose, por exemplo.
Quando o codigo verificar que o "Vini" parou de repetir, ela copia a range de (B) a (H) e joga pra uma nova workbook com o nome "Vini".

A ideia é fazer isso até o final das linhas pra todos os nomes que aparecerem.

Podem me ajudar?

Answer 1

Vinivi,

   Achei uma macro que talvez te interesse:

=================================================
Excel planilhha vba compara copia nao duplicados ordena e lista não comuns 

1-) A macro copia a lista na coluna BA, classificar sem duplicados "Ok...., veja "
2-) Após editar o arquivo (clicando em um botão), cópia da lista na coluna BB, tipo sem duplicados e em ordem crescente.
2b-) Depois compare a lista de coluna da coluna BA e BB, se um nome de coluna BA não está mais na lista de coluna de Pesquisa com o 
Col(BB) (Por favor preencha o Lista de  "Dados" dos ítens na coluna Dados ) +  Copy o ÍTEM na folha de  Auxiliar celula(B7)  B7 e imprimir a folha,  então a mensagem  " ítem avaliado enviado para lista de impressão, com certeza o ítem foi separado para impressão  imprido.

Sub Copiar_dados_em_comum()
  Dim vUltimaLinColC As Long, vUltimaLinOrdem As Long, vUltimaColLin As Integer
  Dim vUltimaLin1 As Long, vUltimaLin2 As Long, vLinha As Long, Rng As Range
  Dim vProcura As String
  
  'o que faremos na planilha principal, usa o with para não ficar repetindo o nome da planilha
  With Sheets("Principal")
  
  [A8].Select
    ' localizar última linha da coluna C
    vUltimaLinColC = .Range("C" & Rows.Count).End(xlUp).Row
    
    ' ultima coluna usada na linha 1
    vUltimaColLin = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
    
    ' Se esta coluna for <= 53 ª a 53 ª seguida
    If vUltimaColLin < 52 Then vUltimaColLin = 53
    
    ' Copiar com filtro avançado
    .Range("C5:C" & vUltimaLinColC).AdvancedFilter Action:=xlFilterCopy, _
            CopyToRange:=.Cells(1, vUltimaColLin), Unique:=True
    
    ' ultima linha para classificação em ordem
    vUltimaLinOrdem = .Cells(Rows.Count, vUltimaColLin).End(xlUp).Row
   
   'Classificar a coluna Atual
    .Range(.Cells(1, vUltimaColLin), .Cells(vUltimaLinOrdem, vUltimaColLin)).Sort Key1:=.Cells(1, vUltimaColLin), Order1:=xlAscending, Header:=xlGuess, _    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    
    ' Se somente a coluna BA estiver cheia, exit sub
      If vUltimaColLin = 53 Then Exit Sub
    
    ' Caso contrário compare as duas colunas
    vUltimaLin1 = .Cells(Rows.Count, vUltimaColLin - 1).End(xlUp).Row
    vUltimaLin2 = .Cells(Rows.Count, vUltimaColLin).End(xlUp).Row
    
    ' Definir O local de busca na segunda coluna
    Set Rng = .Range(.Cells(1, vUltimaColLin), .Cells(vUltimaLin2, vUltimaColLin))
      ' para cada linha na primeira coluna
    For vLinha = 1 To vUltimaLin1
      ' Recuperar o nome da coluna antes da última
      vProcura = .Cells(vLinha, vUltimaColLin - 1).Value
      ' Procurar o nome na coluna ao lado
     '
      If vProcuraLinha(Sheets("Principal"), Rng, vProcura) = 0 Then
         MsgBox "Atenção será preenchida a Lista do ítem ...: [ " & vProcura & " ]", vbInformation, "Saberexcel" '1
         ActiveCell.Value = vProcura
         ActiveCell.Offset(1, 0).Value = vProcura
         ActiveCell.Offset(1, 0).Select
         Sheets("Auxiliar").Range("B7").Value = vProcura
         'Sheets("Auxiliar").PrintOut  'desabilitei senão vai jogar cada volta na fila de impressão...
         'aqui no caso poderá imprimir a lista de não comuns
         MsgBox "Ítem enviado para Lista  de avaliação - ítem...: [ " & vProcura & " ] e também para impressão", vbInformation, "Saberexcel" '2
      End If
    Next vLinha
    
  End With
  Set Rng = Nothing
End Sub


'Função para busca e localização, simples, para fazer uma função voce poderá usar o recurso
'do proprio aplicativo, o que ensino na lição 1 do nosso curso, como trabalhar com o GM


Function vProcuraLinha(Sht As Worksheet, Rng As Range, Localiza As String)
  On Error Resume Next
  vProcuraLinha = 0
  With Sht
    With Rng
      vProcuraLinha = .Find(What:=Localiza, LookIn:=xlValues, LookAt:=xlPart, _
                      SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
                      SearchFormat:=False).Row
    End With
  End With
End Function

http://www.microsoftexcel.com.br/index.php/excel-dicas-microsoft-excel-vba/301-excel-vba-compara/781-excel-planilhha-vba-compara-copia-nao-duplicados-ordena-e-lista-nao-comuns.html
=================================================

   Veja também:

=================================================
Macro para copiar e colar em Loop páginas e dados da mesma Planilha

https://social.msdn.microsoft.com/Forums/pt-BR/b8442cc4-87f7-4965-8923-82594a768486/macro-para-copiar-e-colar-em-loop-pginas-e-dados-da-mesma-planilha
=================================================
excel - Procurar valores repetidos em uma coluna e copiá-los na coluna seguinte sem as repetições  
 Por koalabala, Agosto 25, 2010 em Microsoft Office  

https://forum.baboo.com.br/index.php?/topic/734219-excel-procurar-valores-repetidos-em-uma-coluna-e-copi%C3%A1-los-na-coluna-seguinte-sem-as-repeti%C3%A7%C3%B5es/
=================================================
Vídeo aula 18 - Inserindo dados sem repetição e em ordem alfabética em combobox/listbox  
Renam Ruthes   
Publicado em 19 de jun de 2013

https://youtu.be/v0-D7PX_tiU
=================================================

[]'s,
Fabio I.