Relazione tra numeri di due file

Option Explicit
Sub copia()
Dim Wb1 As Workbook, Wb2 As Workbook, Ws1 As Worksheet, Ws2 As Worksheet
Dim Percorso As String, nomeFile As String, Fg As String, Rg As Object, Area As Range
Dim Ur1 As Long, Ur2 As Long, X As Long, R As Long, Rr As Long
Percorso = ThisWorkbook.Path
Set Wb1 = Workbooks("Importazione.xlsm") 'Nome files 1, Casomai cambiare
Set Ws1 = Wb1.Worksheets("Importazione") ' Nome foglio 1, Casomai cambiare
Ur1 = Ws1.Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = True
If Ur1 > 1 Then Ws1.Range("B2:D" & Ur1).ClearContents
    Ur1 = Ws1.Range("A" & Rows.Count).End(xlUp).Row
    nomeFile = "matrice.xlsx" 'Nome files 2, Casomai cambiare
    Workbooks.Open (Percorso & "\" & nomeFile)
    Set Wb2 = Workbooks(nomeFile)
    Fg = "matrice" 'Nome foglio 2, Casomai cambiare
    Set Ws2 = Wb2.Worksheets(Fg)
Ur1 = Ws2.Range("A" & Rows.Count).End(xlUp).Row
R = 2
Set Area = Ws2.Range("A2:A" & Ur1)
    For X = 2 To Ur1
        Set Rg = Area.Find(Ws1.Cells(X, 1), LookIn:=xlValues, LookAt:=xlWhole)
        If Not Rg Is Nothing Then
            Rr = Rg.Row
            Ws1.Cells(X, 2) = Ws2.Cells(Rr, 2)
            Ws1.Cells(X, 3) = Ws2.Cells(Rr, 3)
            Ws1.Cells(X, 4) = Ws2.Cells(Rr, 4)
            R = R + 1
        End If
    Next X
Wb2.Close (Percorso & "\" & nomeFile)
Application.ScreenUpdating = True
Set Wb1 = Nothing
Set Wb2 = Nothing
Set Ws1 = Nothing
Set Ws2 = Nothing
Set Area = Nothing
Set Rg = Nothing
MsgBox "Fatto"
End Sub