Sub Transfert()
Dim i%, j%, Plage As Range, Dc%
Dim Ws As Worksheet, Wd As Worksheet
Set Ws = Sheets("Feuil1")
Set Wd = Sheets("Feuil2")
Dc = Wd.Cells(2, Columns.Count).End(xlToLeft).Column
For i = 2 To Dc
If Ws.Range("C3").Value = Wd.Cells(2, i).Value Then
Wd.Range(Wd.Cells(3, i), Wd.Cells(10, i)).FormulaArray = WorksheetFunction.Transpose(Ws.Range(Ws.Cells(18, 3), Ws.Cells(18, 10)))
End If
Next i
End Sub