Modifier tableau 3 colonnes en 1 seule

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

Sub Essai()
  Set d = CreateObject("Scripting.Dictionary")
  For Each c In Range("A5", [A65000].End(xlUp))
     If c.Offset(, 1) = "oui" Then d(c.Address & " Lot1") = c.Value
  Next c
  For Each c In Range("A5", [A65000].End(xlUp))
     If c.Offset(, 2) = "oui" Then d(c.Address & " Lot2") = c.Value
  Next c
  ligne = 5
  For Each c In d.keys
    a = Split(c, " "): a(0) = d(c)
    If IsNumeric(a(0)) Then Cells(ligne, "h") = CDbl(a(0)) Else Cells(ligne, "h") = a(0)
    Cells(ligne, "h").Offset(, 1) = a(1)
    ligne = ligne + 1
  Next
End Sub