Option Explicit
Sub transfert()
If ActiveSheet.Name <> "Formulaire" Then Exit Sub
Dim lig&: Application.ScreenUpdating = 0
With Worksheets("Base de données")
lig = .Cells(Rows.Count, 1).End(3).Row + 1
With .Cells(lig, 1).Resize(, 18)
.Value = WorksheetFunction.Transpose([B5:B22])
.Borders.LineStyle = 1
End With
End With
[B7:B17] = Empty: [B5] = [B5] + 1: [B7].Select
End Sub