Sub MergeDistinct()
 
Dim R As Range
Dim LastCell As Range
Dim WS As Worksheet
Dim N As Long
Dim M As Long
Dim StartList1 As Range
Dim StartList2 As Range
Dim StartOutputList As Range
Dim ColumnToMatch As Variant
Dim ColumnsToCopy As Long
 
' Nesta coluna estão os valores que serão comparados no teste
ColumnToMatch = "C"
 
' Número de colunas que serão copiadas a partir da coluna de comparação
ColumnsToCopy = 1
 
' A lista gerada inicia nesta célula.
Set StartOutputList = Worksheets("Plan3").Range("A1")
 
' A primeira lista a ser mesclada inicia aqui.
Set StartList1 = Worksheets("Plan1").Range(ColumnToMatch & "1")
 
Set WS = StartList1.Worksheet
With WS
M = 1
' Retorna a última célula usada nesta planilha.
Set LastCell = .Cells(.Rows.Count, StartList1.Column).End(xlUp)
' Loop para comparar os valores
For Each R In .Range(StartList1, LastCell)
If R.Value <> vbNullString Then
N = Application.CountIf(StartOutputList.Resize(M, 1), _
R.EntireRow.Cells(1, ColumnToMatch).Text)
' Se N = 0, então o item ainda não foi colocado na nova lista
' então será copiado. Se N > 0, nós já o listamos
' e não faremos mais nada.
If N = 0 Then
StartOutputList(M, 1).Resize(1, ColumnsToCopy).Value = _
R.Resize(1, ColumnsToCopy).Value
' M é o número de linhas da lista agrupada. É incrementado neste loop.
M = M + 1
End If
End If
Next R
End With
 
' A segunda lista a ser mesclada inicia aqui.
Set StartList2 = Worksheets("Plan2").Range(ColumnToMatch & "1")
Set WS = StartList2.Worksheet
With WS
Set LastCell = .Cells(.Rows.Count, StartList2.Column).End(xlUp)
For Each R In .Range(StartList2, LastCell)
If R.Value <> vbNullString Then
N = Application.CountIf(StartOutputList.Resize(M, 1), _
R.EntireRow.Cells(1, ColumnToMatch).Text)
If N = 0 Then
StartOutputList(M, 1).Resize(1, ColumnsToCopy).Value = _
R.Resize(1, ColumnsToCopy).Value
M = M + 1
End If
End If
Next R
End With
 
End Sub