Liaison "dynamique" entre 2 classeurs

Private Sub Workbook_Open()
    Dim oldaddress As String, newaddress As String
    Dim FSO As New FileSystemObject
    Dim Sheet As Object
    'Compare addresses
    oldaddress = Names("path").Value
    oldaddress = Mid$(oldaddress, 3, Len(oldaddress) - 3)
    newaddress = Names("relpath").Value
    newaddress = FSO.GetAbsolutePathName(ThisWorkbook.Path & "\" & Mid$(newaddress, 3, Len(newaddress) - 3))
    'If they are different
    If newaddress <> oldaddress Then
        'Replace occurences
        For Each Sheet In ThisWorkbook.Sheets
            Sheet.Cells.Replace oldaddress, newaddress
        Next
        'Save current address
        Names("path").Value = newaddress
    End If
End Sub