Comparar celulas de guais diferentes e copiar para nova guia caso igual
Página 1 de 1
Comparar celulas de guais diferentes e copiar para nova guia caso igual
Boa tarde!!
- Código:
Sub Comapar_Copiar_Celula()
'Compara os dados entre duas guias, caso igual, adiciona uma nova guia e cola a informação.
On Error Resume Next
Dim ws1, ws2, ws3 As Worksheet, c1, c2 As Range, addedSheet As Boolean
Set ws1 = Sheets("Plan1")
Set ws2 = Sheets("Plan2")
Application.ScreenUpdating = False
addedSheet = False
For Each c2 In ws2.Range("A2", ws2.Range("A" & Rows.Count).End(xlUp))
For Each c1 In ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp))
If c1 = c2 Then
If Not addedSheet Then
addedSheet = True
Set ws3 = Sheets.Add
ws1.Rows(1).Copy ws3.Range("A1")
End If
c1.EntireRow.Copy ws3.Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next
Next
ws3.Cells.EntireColumn.AutoFit
ws3.Range("A1").Activate
Application.ScreenUpdating = True
End Sub
alexandrevba- Intermediário
- Mensagens : 222
Data de inscrição : 26/06/2012
Localização : Serra-ES
Tópicos semelhantes
» Copiar duas células fixa de todas as guias para uma única guia, mas colando em duas colunas diferentes.
» Copiar dados baseado em cabeçalho de uma guia para outra guia
» Copiar Com Critério para outra Guia
» Copiar Mesmo Intervalo Uma Guia Para Duas Guias Dif
» Filtrar varias Guias baseado 1 critério copiar os dados para 1 guia
» Copiar dados baseado em cabeçalho de uma guia para outra guia
» Copiar Com Critério para outra Guia
» Copiar Mesmo Intervalo Uma Guia Para Duas Guias Dif
» Filtrar varias Guias baseado 1 critério copiar os dados para 1 guia
Página 1 de 1
Permissões neste sub-fórum
Não podes responder a tópicos
|
|