Mettre à jour un champs dans un autre fichier

'### Constantes à adapter ###
Const FICHIER_B As String = "C:\Fichier B.xls"
Const FEUILLE_B As String = "LISTE"
Const NOM_PLAGE_B As String = "Etape"
'############################

Sub UpdateChampB()
Dim WB As Workbook
Dim S As Worksheet
Dim R As Range
Dim N As Name
Dim var
Dim T()
Dim i&
Dim cpt&
If TypeName(Selection) <> "Range" Then Exit Sub
For Each R In Selection
  If R.Column <> 1 Then Exit Sub
  If R.Row < 5 Then Exit Sub
  If R <> "" Then
    cpt& = cpt& + 1
    ReDim Preserve T(1 To 1, 1 To cpt&)
    T(1, cpt&) = R
  End If
Next R
If cpt& = 0 Then Exit Sub
On Error GoTo Erreur
Application.ScreenUpdating = False
Set WB = GetObject(FICHIER_B)
WB.Windows(1).Visible = True
Set S = WB.Sheets(FEUILLE_B)
Set R = S.[h4].CurrentRegion
Set R = R.Resize(R.Rows.Count - 1, 1)
Set R = R.Offset(1, 0)
R.ClearContents
Set R = S.Range("h4:h" & UBound(T, 2) + 3 & "")
R = Application.WorksheetFunction.Transpose(T)
On Error Resume Next
Set N = WB.Names(NOM_PLAGE_B)
If Err <> 0 Then
  WB.Names.Add Name:="Etape", RefersTo:="='" & S.Name & "'!" & R.Address & ""
Else
  WB.Names.RefersTo = "='" & S.Name & "'!" & R.Address & ""
End If
Err.Clear
Erreur:
If Not WB Is Nothing Then
  WB.Close savechanges:=True
  Set WB = Nothing
End If
Application.ScreenUpdating = ture
If Err <> 0 Then MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
End Sub