XL 2016 copier coller un lien avec d'autre fichier excel

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sem1$, lien As Boolean, sem2$, col As Variant, f$
With Cells(2, Target.Column).MergeArea(1) 'semaines en ligne 2
  If Not Target(1).HasFormula Or Not .Value Like "SEMAINE*" Then Exit Sub
  Cancel = True
  sem1 = Right(.Value, 2)
  lien = Target(1).Formula Like "*]" & sem1 & "*"
  Do
    sem2 = Format(InputBox("Entrez le numéro de la semaine de destination :", _
      "Copier " & IIf(lien, "le lien", "la formule"), IIf(sem2 = "", Format(Val(sem1) + 1, "00"), sem2)), "00")
    If sem2 = "" Then Exit Sub
    col = Application.Match("*" & sem2, .EntireRow, 0)
  Loop While IsError(col)
  f = Target(1).FormulaR1C1
  If lien Then
    Application.DisplayAlerts = False 'si le lien ne mène nulle part
    With Cells(Target.Row, .Column)
      .FormulaR1C1 = f 'sécurité
      f = Replace(.Formula, "]" & sem1, "]" & sem2)
    End With
  End If
End With
Cells(Target.Row, col).Resize(, 7) = f
End Sub

Private Sub Worksheet_Change(ByVal r As Range)
Dim f$, c As Range
Set r = Intersect(r, Range("C4:C" & Rows.Count), UsedRange) 'colonne C adaptable
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si les liens ne mènent nulle part
Application.EnableEvents = False 'désactive les évènements
For Each r In r 'si entrées multiples (copier-coller)
  If r.HasFormula Then
    f = IIf(r.Formula Like "*]01*", r.Formula, r.FormulaR1C1)
    For Each c In Range("C2", Cells(2, Columns.Count).End(xlToLeft))
      If c Like "SEMAINE*" Then Cells(r.Row, c.Column).Resize(, 7) = Replace(f, "]01", "]" & Right(c, 2))
    Next c
  End If
Next r
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim deb As Range, pas&, ncol, nom$, tablo(), i&, j%, t
Set deb = [A3] 'adaptable
pas = 13 'adaptable
ncol = 3 'colonnes A:C, adaptable
If Intersect(Target, deb) Is Nothing Then Exit Sub
Cancel = True
If deb = "" Then MsgBox deb.Address(0, 0) & " doit être renseignée...": Exit Sub
If MsgBox("Les lignes " & deb.Row + 1 & ":" & deb.Row + pas - 1 & _
  " vont être collées en A" & deb.Row + pas + 1 & " A" & deb.Row + 2 * pas + 1 & " etc...", 52, "Copier") = 7 Then Exit Sub
Application.DisplayAlerts = False 'si les liens ne mènent nulle part
'---adaptation éventuelle des liens au nom en deb---
nom = Application.Proper(deb)
Application.EnableEvents = False 'désactive les évènements
deb(2).Resize(pas - 1, ncol).Replace "[*.xls", "[" & nom & ".xls", xlPart
Application.EnableEvents = True 'réactive les évènements
'---remplissage du tableau source---
ReDim tablo(1 To pas - 1, 1 To ncol)
For i = 1 To pas - 1
  For j = 1 To ncol
    If j = 1 Or deb(i + 1, j).HasFormula Then _
      tablo(i, j) = IIf(deb(i + 1, j).Formula Like "*]01*", deb(i + 1, j).Formula, deb(i + 1, j).FormulaR1C1)
Next j, i
'---copie vers le bas---
While deb <> "" 'la boucle s'arrête s'il n'y a pas de nom
  t = tablo
  For i = 1 To pas - 1
    t(i, ncol) = Replace(tablo(i, ncol), "[" & nom, "[" & Application.Proper(deb))
  Next i
  deb(2).Resize(pas - 1, ncol) = t 'lance la Worksheet_Change
  Application.ScreenUpdating = True 'pour voir tout de suite le résultat
  DoEvents
  Set deb = deb.Offset(pas) 'incrémentation
Wend
End Sub