Visual Basic - Actualizar

Sub COPIAR()

Dim UNICOS As New Collection

Set H1 = Worksheets("HOJA1")

Set H2 = Worksheets("HOJA2")

Set DATOS = H1.Range("A1").CurrentRegion

Set ACTUAL = H2.Range("A1").CurrentRegion

AFILAS = ACTUAL.Rows.Count

ACTUAL.Sort KEY1:=H2.Range(ACTUAL.Columns(1).Address), ORDER1:=xlAscending, Header:=xlYes

With DATOS

    Set DATOS = .Rows(2).Resize(.Rows.Count - 1, .Columns.Count)

    .Sort KEY1:=H1.Range(.Columns(1).Address), ORDER1:=xlAscending

    DFILAS = .Rows.Count:    RESTA = AFILAS - DFILAS

    If RESTA = 0 Then GoTo FIN

    Set NUEVOS = .Rows(DFILAS + 1).Resize(RESTA, 1)

    x = 1

    With ACTUAL

        For I = 2 To .Rows.Count

            NOMBRE = .Cells(I, 1)

            On Error Resume Next

            BUSCA = WorksheetFunction.Match(NOMBRE, DATOS.Columns(1), 0)

            If Err.Number > 0 Then NUEVOS.Cells(x, 1) = NOMBRE: x = x + 1

            On Error GoTo 0

        Next I

    End With

    Set DATOS = .CurrentRegion

     .Sort KEY1:=H1.Range(.Columns(1).Address), ORDER1:=xlAscending, Header:=xlYes

End With

FIN:

End Sub