Sub test()
Dim WsS As Worksheet, WsC As Worksheet
Dim LigneS As Long, LigneC As Long
Dim ColonneC As Integer
Set WsS = Worksheets("Source")
Set WsC = Worksheets("cible")
For LigneS = 1 To WsS.Range("A" & Rows.Count).End(xlUp).Row
If WsS.Cells(LigneS, 1) Like "*Château*" Then
ColonneC = 1
LigneC = LigneC + 1
Else
ColonneC = ColonneC + 1
End If
WsS.Cells(LigneS, 1).Copy WsC.Cells(LigneC, ColonneC)
Next LigneS
End Sub