Option Explicit
Option Compare Text
Sub test()
Dim a, b(), i As Long, j As Long, n As Long
Application.ScreenUpdating = False
a = Sheets(1).Range("a3").CurrentRegion.Value
ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 1) + 1, 1 To 2)
b(1, 1) = "Lot": b(1, 2) = "Donnée"
n = 1
For i = 2 To UBound(a, 2)
For j = 2 To UBound(a, 1)
If a(j, i) = "oui" Then
n = n + 1
b(n, 1) = a(1, i)
b(n, 2) = a(j, 1)
End If
Next
Next
'Restitution en Feuil2
With Sheets(2)
.Cells.Clear
If n > 1 Then
With .Cells(1)
.Resize(n, 2).Value = b
With .CurrentRegion
With .Rows(1)
.BorderAround Weight:=xlThin
.Interior.ColorIndex = 44
End With
.Font.Name = "calibri"
.Font.Size = 10
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
'.Columns.AutoFit
End With
End With
Else
MsgBox "Aucune donnée"
End If
End With
Application.ScreenUpdating = True
End Sub