Comparar celulas de guais diferentes e copiar para nova guia caso igual

Ver o tópico anterior Ver o tópico seguinte Ir em baixo

Comparar celulas de guais diferentes e copiar para nova guia caso igual

Mensagem por alexandrevba em Qua Out 02, 2013 12:26 pm

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
avatar
alexandrevba
Intermediário
Intermediário

Mensagens : 222
Data de inscrição : 26/06/2012
Localização : Serra-ES

Ver perfil do usuário

Voltar ao Topo Ir em baixo

Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo

- Tópicos similares

 
Permissão deste fórum:
Você não pode responder aos tópicos neste fórum