XL 2010 extraction donnees [resolu]

Private Sub Worksheet_Activate()
Dim t, nlig&, j%, proces$, i&, n&, resu()
t = Sheets("Feuil1").[B2:H17] 'matrice, plus rapide, plage à adapter
nlig = UBound(t)
For j = 1 To UBound(t, 2)
    If LCase(t(1, j)) = "oui" Then
        proces = t(3, j)
        For i = 4 To nlig
            If t(i, j) <> "" Then
                n = n + 1
                ReDim Preserve resu(1 To 2, 1 To n)
                resu(1, n) = proces
                resu(2, n) = t(i, 1)
            End If
        Next
    End If
Next
'---transposition---
ReDim t(1 To n, 1 To 2)
For i = 1 To n
    t(i, 1) = resu(1, i)
    t(i, 2) = resu(2, i)
Next
'---restitution---
With [A2] 'cellule à adapter
    If n Then .Resize(n, 2) = t
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ sous le tableau
End With
Columns(2).AutoFit 'ajustement largeur
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Sub essai()
  Set d = CreateObject("scripting.dictionary")
  TblImpact = [B2].CurrentRegion.Value: TblBD = [B4].CurrentRegion.Value
  For k = 2 To UBound(TblImpact, 2)
    If TblImpact(1, k) = "oui" Then
      For i = 2 To UBound(TblBD)
        If TblBD(i, k) = "x" Then d(TblBD(1, k) & "|" & TblBD(i, 1)) = ""
      Next i
    End If
  Next k
  Set f = Sheets("feuil2")
  f.[A2].Resize(d.Count) = Application.Transpose(d.keys)
  Application.DisplayAlerts = False
  f.[A2].Resize(d.Count).TextToColumns Other:=True, OtherChar:="|"
End Sub

ReDim b(1 To UBound(a, 1), 1 To 2)

Private Sub Worksheet_Activate()
Dim t, nlig&, j%, proces$, i&, n&, resu()
With Sheets("Feuil1").[B2:H17]
    t = .Value 'matrice, plus rapide, plage à adapter
    ReDim resu(1 To Application.CountIf(.Cells, "x"), 1 To 2)
End With
nlig = UBound(t)
For j = 1 To UBound(t, 2)
    If LCase(t(1, j)) = "oui" Then
        proces = t(3, j)
        For i = 4 To nlig
            If t(i, j) <> "" Then
                n = n + 1
                resu(n, 1) = proces
                resu(n, 2) = t(i, 1)
            End If
        Next
    End If
Next
'---restitution---
With [A2] 'cellule à adapter
    If n Then .Resize(n, 2) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ sous le tableau
End With
Columns(2).AutoFit 'ajustement largeur
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub