VBA - Mensaje de espere

[Laufwerk]

Al final consegui hacerlo. Les pongo el codigo.

Código:

Sub CompareCols()
    'Auto_Open
    encontrada = False
    Dim celda As Range
    Dim rango As Range
    For i = 2 To numRows(1)
        Dim valor As String
        valor = Workbooks(2).Worksheets(1).Range(varcellOriginalColumn1 & i).Value
        
        Windows(myBook(2)).Activate
        Set rango = Range(varCellDestinyColumn1 & 2, varCellDestinyColumn1 & numRows(2))
        
        Set celda = rango.find(What:=valor, LookIn:=xlValues, LookAt:=xlWhole)

      If Not celda Is Nothing Then
        Windows(myBook(2)).Activate
        rowPos = celda.Row
        valueSearch = Range(varCellDestinyCopy & rowPos).Value
        'valueSearch = celda.Value
        'drawColorRow (pos)
        'Selection.Copy
        Windows(myBook(1)).Activate
        Workbooks(2).Sheets(1).Select
        Range(varCellInsertColumn & i).Value = valueSearch
        'drawColorRow (i)
        'ActiveSheet.Paste
      Else
        Windows(myBook(1)).Activate
        Rows(i & ":" & i).Select
        Range("N" & i).Activate
        With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorAccent2
          .TintAndShade = 0
          .PatternTintAndShade = 0
        End With
      End If
    Next i
    
    Set celda = Nothing
    Windows(myBook(2)).Activate
    Columns(varCellInsertColumn & ":" & varCellInsertColumn).EntireColumn.AutoFit
End Sub

Ahora mi proximo paso es comparando dos columnas, si teneis alguna sugerencia....

Gracias!!!!