Inquiridor
PERCORRER COLUNA DE DADOS E COPIAR DADOS PARA UMA NOVA PLANILHA

Pergunta
-
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?
Todas as Respostas
-
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.
- Editado Fabio I quarta-feira, 5 de setembro de 2018 13:34