Sub Macro1()
Dim x%, k%, i%
Dim colsource, coldest, tablo, tabloR()
Dim tab_hypretraite() As Double
tablo = Sheets("BDD").ListObjects("tb_BDD").DataBodyRange
colsource = Array(1, 2, 3, 4, 5, 6, 7, 8)
coldest = Array(1, 2, 3, 6, 7, 9, 12, 13)
With Sheets("Suivi")
If .ListObjects("tb_suivi").DataBodyRange Is Nothing Then .ListObjects("tb_suivi").DataBodyRange
k = 0
For i = 1 To UBound(tablo, 1)
If tablo(i, 9) Like "x" Then
ReDim Preserve tabloR(1 To 15, 1 To k + 1)
For x = LBound(colsource) To UBound(colsource)
tabloR(coldest(x), 1 + k) = tablo(i, colsource(x))
Range("b21").Select
Selection.EntireRow.Insert
Next x
k = 2 + k
End If
Next i
On Error Resume Next
.Cells([tb_suivi].Rows.Count + 21, 1).End(xlUp).Offset(21, 1).Resize(UBound(tabloR, 2), 15) = Application.Transpose(tabloR)
tab_hypretraite(i + 2, k + 2) = .Cells(i, k).Value
Erase tablo: Erase tabloR 'libère la mémoire
End With
MsgBox "Transfert effectué sur feuille Suivi"
Sheets("Suivi").Activate
End Sub