Afficher uniquement les nouvelles entrées

Sub es()
  Dim t(), t1(), t2(), i As Long, m As Object, c As Byte, x
  Application.ScreenUpdating = 0
  Set m = CreateObject("Scripting.Dictionary")
  t2 = Feuil1.Range("b3:b" & Feuil1.Cells(Rows.Count, 2).End(3).Row)
  t = Feuil2.Range("b3:d" & Feuil2.Cells(Rows.Count, 2).End(3).Row)
  For i = 1 To UBound(t2): m(t2(i, 1)) = "":  Next i
   ReDim t1(1 To UBound(t), 1 To 3)
  For i = 1 To UBound(t)
  If Not m.Exists(t(i, 1)) Then
  x = x + 1
  For c = 1 To 3: t1(x, c) = t(i, c): Next c
  End If
  Next i
  Feuil3.[b3].Resize(x, 3) = t1
  Erase t, t1, t2: Set m = Nothing
End Sub

Sub est()
Dim t(), t1(), t2(), i As Long, m As Object, c As Byte, x
  Application.ScreenUpdating = 0
  Set m = CreateObject("Scripting.Dictionary")
  t2 = Feuil1.Range("b3:d" & Feuil1.Cells(Rows.Count, 2).End(3).Row)
  t = Feuil2.Range("b3:d" & Feuil2.Cells(Rows.Count, 2).End(3).Row)
  For i = 1 To UBound(t2)
   m(t2(i, 1) & t2(i, 2) & t2(i, 3)) = ""
  Next i
   ReDim t1(1 To UBound(t), 1 To 3)
  For i = 1 To UBound(t)
  If Not m.Exists(t(i, 1) & t(i, 2) & t(i, 3)) Then
  x = x + 1
  For c = 1 To 3: t1(x, c) = t(i, c): Next c
  End If
  Next i
  Feuil3.[b3].Resize(x, 3) = t1
  Erase t, t1, t2: Set m = Nothing
End Sub

Sub Essai()
Dim a, b(), txt As String, i As Long, n As Long, x, y, e
    Application.ScreenUpdating = False
    a = Sheets("Feuil1").Range("B2").CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            txt = a(i, 1)
            'txt = Join$(Array(a(i, 1), a(i, 2), a(i, 3)))
            .Item(txt) = Array(a(i, 1), a(i, 2), a(i, 3))
        Next
        a = Sheets("Feuil2").Range("B2").CurrentRegion.Value
        ReDim b(1 To UBound(a, 1), 1 To 3)
        For i = 2 To UBound(a, 1)
            txt = a(i, 1)
            'txt = Join$(Array(a(i, 1), a(i, 2), a(i, 3)))
            If .exists(txt) Then
                .Item(txt) = Empty
            Else
                n = n + 1
                b(n, 1) = a(i, 1)
                b(n, 2) = a(i, 2)
                b(n, 3) = a(i, 3)
                .Item(txt) = Empty
            End If
        Next
        For Each e In .keys
            If IsEmpty(.Item(e)) Then .Remove e
        Next
        'x = .Count: y = .items
    End With
    If n > 0 Then
        With Sheets("Feuil3").Cells(1)
            .CurrentRegion.Clear
            .Resize(, 3).Value = [{"Pays","Date","Nuitée"}]
            .Offset(1).Resize(n, 3).Value = b
            With .CurrentRegion
                With .Rows(1)
                    .Interior.ColorIndex = 44
                    .BorderAround Weight:=xlThin
                End With
                .VerticalAlignment = xlCenter
                .HorizontalAlignment = xlCenter
                .Borders(xlInsideVertical).Weight = xlThin
                .BorderAround Weight:=xlThin
            End With
            .Parent.Select
        End With
    Else
        MsgBox "Aucune donnée trouvée"
    End If
    Application.ScreenUpdating = True
End Sub