Option Compare Text
Sub transpose_section()
Application.ScreenUpdating = False
With Sheets("Feuil1").Range("A1:A" & [A65000].End(xlUp).Row)
Set c = .Find("section", LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
Firstaddress = c.Address
Do
derlig = Cells(c.Row, 1).End(xlDown).Row
Range(Cells(c.Row, 1), Cells(derlig, 2)).Copy
Cells(c.Row, 4).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Firstaddress
End If
End With
Columns("A:C").Delete Shift:=xlToLeft
[A1].Select
End Sub