Guru do Excel e Power BI

Public Sub Apagar_Email_ListaA_na_ListaB()
    Dim vrtDadosA           As Variant
    Dim vrtDadosB           As Variant
    Dim strDadosC()         As String
    Dim lngUltLinA          As Long
    Dim lngUltLinB          As Long
    Dim lngContC            As Long
    Dim lngCont             As Long
    
    
    With Planilha1
        lngUltLinA = .Cells(.Rows.Count, 1).End(xlUp).Row
        lngUltLinB = .Cells(.Rows.Count, 2).End(xlUp).Row
        
        vrtDadosA = .Range("A2:A" & lngUltLinA).Value2
        vrtDadosB = .Range("B2:B" & lngUltLinB).Value2
        
        ReDim strDadosC(1 To lngUltLinA) As String
        
        For lngCont = LBound(vrtDadosB) To UBound(vrtDadosB)
            If Application.WorksheetFunction.CountIf(.Range("A2:A" & lngUltLinA), vrtDadosB(lngCont, 1)) = 0 Then
                lngContC = lngContC + 1
                strDadosC(lngContC) = vrtDadosB(lngCont, 1)
            End If
        Next lngCont
        
        ReDim Preserve strDadosC(1 To lngContC) As String
        
        .Range(.Cells(2, 2), .Cells(lngUltLinB, 2)).ClearContents
        .Range("B2:B" & lngContC + 1).Value2 = Application.Transpose(strDadosC)
    End With
    
End Sub