Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Copiar dados iguais...
 
Notifications
Clear all

Copiar dados iguais para outra Plan.

 
2024 - VBA & Macros
Post Recente por Josy 9 anos atrás
6 Posts
3 Usuários
0 Reactions
1,477 Visualizações
RSS
Josy
 Josy
(@josy)
Posts: 0
Trusted Member
Topic starter
 

Encontrei essa macro pesquisando na Net ( https://social.msdn.microsoft.com/Forum ... orum=vbapt)
Sub Main()
Const SOURCE_COLUMN As String = "A"
Const DESTINATION_COLUMN As String = "B"

Dim lastRow As Long
Dim sourceRow As Long
Dim destinationRow As Long
Dim ws As Worksheet

Set ws = ActiveSheet
With ws
lastRow = .Cells(.Rows.Count, SOURCE_COLUMN).End(xlUp).Row
For sourceRow = 1 To lastRow
If .Cells(sourceRow, SOURCE_COLUMN).Interior.ColorIndex <> xlColorIndexNone Then
destinationRow = destinationRow + 1
.Cells(sourceRow, SOURCE_COLUMN).Copy
.Cells(destinationRow, DESTINATION_COLUMN).PasteSpecial Paste:=xlPasteValues
End If
Next sourceRow
End With
End Sub
Segundo a informação ela deveria copiar as células coloridas. Tentei na planilha que tenho fazendo as alterações de "B" para "Q", mas não funcionou pq na planilha que tenho colori por formatação condicional valores duplicados.

O que eu realmente preciso, é de um caminho, seja por cor, proc... sei lá... uma forma que os valores na coluna "B" (que é um texto, nome) se iguais/ repetidos, sejam copiados para outra Plan, de preferência. Se não for possível,copie na mesma plan mas a partir da coluna "Q". Copie os valores de A e de B para que possa encontrar os valores (nomes) iguais. Em "A" contém números de 1 á 30.000 e em "B" os nomes.
Alguém aí pode me ajudar? :oops:

Att
Josy Martins
Estamos tão preocupados c/ o q queremos ter, q ás vezes nos esquecemos d agradecer o q já temos. Afinal, gratidão significa q a energia recebida deve ser devolvida.
Feliz aqle q transfere o q sabe e aprende o q ensina.

 
Postado : 26/08/2015 9:36 am
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Isso é facil de fazer disponibilize uma pequena parte da sua plan com dados de exemplo a ideia é saber exatamente saber de onde para onde sera copiado os dados.

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 26/08/2015 11:41 am
Josy
 Josy
(@josy)
Posts: 0
Trusted Member
Topic starter
 

Olá!

Agradeço sua boa intenção em me ajudar desde já. Muito obrigada mesmo. :D

Att
Josy Martins
Estamos tão preocupados c/ o q queremos ter, q ás vezes nos esquecemos d agradecer o q já temos. Afinal, gratidão significa q a energia recebida deve ser devolvida.
Feliz aqle q transfere o q sabe e aprende o q ensina.

 
Postado : 27/08/2015 6:02 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Josy, o que acontece referente a cor que uma celula está preenchida por Formatação Condicional, em uma explicação mais simples, é que ela é aplicada tipo em segundo plano, diferente de quando definimos o Interior.Color de uma celula, e na Formatação Condicional ainda podemos ter variações de cores e tambem imagens, nestes casos o que conseguimos atraves de rotina é identificar o estado da celula, se alteração foi por fomatação condicional ou não, de uma olhada no link abaixo, tem algumas Functions:
Conditional Formatting Colors - http://www.cpearson.com/excel/CFColors.htm

Eu não utilizaria este recurso se podemos fazer de forma simples, somente pelos valores repetidos, copie a rotina abaixo e coloque em seu exemplo e veja se é isto, é verificado na aba "Cadastro" coluna "B" os repetidos e copiados para a "Plan3", se alterar os nomes das abas está bem fácil ajustar na rotina.

Option Explicit

Sub CopiaDuplicados()

    Dim wstSource As Worksheet, wstOutput As Worksheet
    Dim rngCell As Range, rngMyData As Range
    Dim lngMyRow As Long
    
    Set wstSource = Worksheets("Cadastro")
    Set wstOutput = Worksheets("Plan3")
    Set rngMyData = wstSource.Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    
    Application.ScreenUpdating = False
    
    For Each rngCell In rngMyData
        
        If Evaluate("COUNTIF(" & rngMyData.Address & "," & rngCell.Address & ")") > 1 Then
            
            lngMyRow = wstOutput.Cells(Rows.Count, "A").End(xlUp).Row + 1
            
            wstSource.Range("A" & rngCell.Row & ":B" & rngCell.Row).Copy _
                Destination:=wstOutput.Range("A" & lngMyRow & ":B" & lngMyRow)
        End If
        
    Next rngCell
    
    Application.ScreenUpdating = True

End Sub

Qualquer duvida retorne.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 27/08/2015 10:55 am
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Não entendi direito vc quer copiar todas as vezes que o nome aparecer duplicado ou apenas identificar os duplicados??

Exemplo se o nome aparecer 5 vezes na lista ele devera copiar 5 vezes pra a outra plan??? ou apenas 1

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 27/08/2015 10:59 am
Josy
 Josy
(@josy)
Posts: 0
Trusted Member
Topic starter
 

Perfeito!!!

Muito obrigada, Mauro Coutinho!!! Melhor impossível!!!

Att
Josy Martins
Estamos tão preocupados c/ o q queremos ter, q ás vezes nos esquecemos d agradecer o q já temos. Afinal, gratidão significa q a energia recebida deve ser devolvida.
Feliz aqle q transfere o q sabe e aprende o q ensina.

 
Postado : 27/08/2015 11:51 am
Forum Jump:
  Tópico Anterior
Próximo Tópico