XL 2013 Problème lignes vides en sus lors exécution d'une macro _ Resolu

Option Explicit
Sub Ajout()

 

 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))
 
  Sheets("Suivi").Activate
  Range("b21").Select
  Selection.EntireRow.Insert

         Next x
     k = 1 + 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 + 1, k + 1) = .Cells(i, k).Value
   Range("B21").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
   MsgBox "Transfert effectué sur feuille Suivi"
   Sheets("Suivi").Activate
End Sub