erreur ecriture

Sub Macro1()
Dim Vsearch As Date, plg As Range
Dim fSource As String, rep As String, fichier As String
Dim fCible As String, c As Range, i As Byte, T(2) As Variant
Dim ws As Worksheet, d As Range

Vsearch = Sheets("feuil1").Cells(15, 3)
Set plg = ActiveSheet.Range("A18:A" & Range("A50000").End(xlUp).Row)
fSource = ActiveWorkbook.Name
rep = ActiveWorkbook.Path & "\E\"
fichier = Dir(rep & "*.xlsx")

Application.ScreenUpdating = False

Do While fichier <> ""
    Workbooks.Open rep & fichier
    fCible = Split(ActiveWorkbook.Name, ".")(0)
    Set c = plg.Find(fCible)
        If Not c Is Nothing Then
            For i = 0 To 2
                T(i) = c.Offset(0, i + 1)
            Next
        End If
    For Each ws In ActiveWorkbook.Sheets
        Set d = ws.Range("A1:A10000").Find(Vsearch)
        If Not d Is Nothing Then Range(Cells(d.Row, 2), Cells(d.Row, 4)) = T()
    Next
    ActiveWorkbook.Close True
    fichier = Dir
Loop

Application.ScreenUpdating = True

End Sub

'renvoie la première dimension d'un tableau créé à partir
'du nom du fichier et de son extension
fCible = Split(ActiveWorkbook.Name, ".")(0)
'on associe la variable c à la cellule trouvée contenant fcible
Set c = plg.Find(fCible)
'si c existe
If Not c Is Nothing Then
'on ajoute les 3 valeurs adjacente dans un tableau T
For i = 0 To 2
T(i) = c.Offset(0, i + 1)
Next
End If
'on boucle sur chaque feuille du classeur actif(est ce bien utile ?)
For Each ws In ActiveWorkbook.Sheets
'on associe la variable c à la cellule trouvée contenant Vsearch (la date)
Set d = ws.Range("A1:A10000").Find(Vsearch)
'si d existe, on place dans les 3 cellules adjacentes les valeurs du tableau T
If Not d Is Nothing Then Range(Cells(d.Row, 2), Cells(d.Row, 4)) = T()