Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Row <> 5 Then Exit Sub
Dim F$, test As Boolean, Nom$, W As Workbook
On Error Resume Next
F = Dir(ThisWorkbook.Path & "\*.xls") '1er fichier du dossier
While F <> ""
test = True
test = IsError(Workbooks(F).Name)
If test Then 'si le fichier F n'est pas ouvert
Application.ScreenUpdating = False
Workbooks.Open ThisWorkbook.Path & "\" & F 'ouverture de F
End If
F = Dir 'fichier suivant
Wend
ThisWorkbook.Activate
F = Sh.Name
For Each W In Workbooks
Nom = Replace(W.Name, ".xls", "")
With W.Sheets(F)
.[B8:C38].Offset(0, Application.Match(Target, .[5:5], 0) - 2).Copy _
Cells(8, Target.Column + Application.Match(Nom, Range(Cells(6, Target.Column), [IV6]), 0) - 1)
End With
Next
End Sub