Créer un recap de plusieurs feuilles

Application.CountA([B:B])

Sub Bouton3_Cliquer()
Dim fl As Worksheet, i As Long
Dim Cell As Range

i = 4
Range("A4:A65536").Font.Bold = True
For Each fl In ActiveWorkbook.WorkSheets
   If (fl.Name = "Home") Or (fl.Name = "Recap_Quantité") Or (fl.Name = "Propriété") Or (fl.Name = "Fonctionnalité") Or (fl.Name = "x") Or (fl.Name = "y") Or (fl.Name = "Listes2") Or (fl.Name = "Listes0") Then
   'Sinon, le nom de la feuille est différente
   Else
    'Si colonne B est non vide :
      With fl
        If Application.CountA(.[B:B]) <> 0 Then ' A NOTER : le point devant [B:B]
            'COPIE-COLLE
        End If
      End With
    End If
Next fl

 i 

Sub Bouton3_Cliquer()
Dim fl As Worksheet, i As Long, drLigfl As Long
Dim TabFeuils(), TabIn()

'ICI, on créé une variable tableau contenant le nom des feuilles à exclure.
    'Tu peux y ajouter toutes celles que tu souhaites.
TabFeuils = Array("Home", "Recap_Quantité", "Propriété", "Fonctionnalité", "x", "y", "Listes2", "Listes0")

Range("A4:A65536").Font.Bold = True
For Each fl In ActiveWorkbook.Worksheets
  'La fonction EQUIV d'Excel permet de rechercher la position d'un élément dans un tableau
  'en VBA cette fonction s'intitule Match et renvoie une erreur quand l'élément ne fait pas partie du tableau
  'On teste donc si Match renvoie une erreur c'est que la feuille doit être traitée...
  If IsError(Application.Match(fl.Name, TabFeuils, 0)) Then
    'Dans la feuille fl
    With fl
      'Si la colonne B n'est pas vide
      If Application.CountA(.[B:B]) <> 0 Then ' A NOTER : le point devant [B:B]
        'COPIE-COLLE
        'Calcul dernière ligne non vide colonne B feuille fl :
        drLigfl = .Range("B" & Rows.Count).End(xlUp).Row
        'On stocke toutes les lignes de fl dans une variable tableau
        TabIn = .Range("B4:G" & drLigfl)
        'On boucle sur toutes les lignes de notre tableau TabIn
        For i = LBound(TabIn, 1) To UBound(TabIn, 1)
          'Si une ligne de la colonne B est non vide, TabIn(i, 1) sera non vide
          If TabIn(i, 1) <> "" Then
            'Si ligne non vide, on copie colle
            .Range("B" & i + 4 & ":G" & i + 4).Copy Sheets("Recap_Quantité").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
          End If
        Next i
      End If
    End With
  End If
Next fl
End Sub

 .Range("B" & i + 4 & ":G" & i + 4).Copy

 .Range("B" & i + 3 & ":G" & i + 3).Copy

Sub CreerRecap()
Dim fl As Worksheet, i As Long, drLigfl As Long, drLigRecap As Long
Dim TabFeuils(), TabIn()

'ICI, on créé une variable tableau contenant le nom des feuilles à exclure.
    'Tu peux y ajouter toutes celles que tu souhaites.
TabFeuils = Array("Home", "Recap_Quantité", "Propriété", "Fonctionnalité", "Sécurité", "Environnement", "Listes2", "Listes0")

Range("A4:A65536").Font.Bold = True
For Each fl In ActiveWorkbook.Worksheets
  'La fonction EQUIV d'Excel permet de rechercher la position d'un élément dans un tableau
  'en VBA cette fonction s'intitule Match et renvoie une erreur quand l'élément ne fait pas partie du tableau
  'On teste donc si Match renvoie une erreur c'est que la feuille doit être traitée...
  If IsError(Application.Match(fl.Name, TabFeuils, 0)) Then
    'Dans la feuille fl
    With fl
      'Si la colonne B n'est pas vide
      If Application.CountA(.[B:B]) <> 0 Then ' A NOTER : le point devant [B:B]
        'COPIE-COLLE
        'Calcul dernière ligne non vide colonne B feuille fl :
        drLigfl = .Range("B" & Rows.Count).End(xlUp).Row
        'On stocke toutes les lignes de fl dans une variable tableau
        TabIn = .Range("B4:G" & drLigfl)
        'On boucle sur toutes les lignes de notre tableau TabIn
        For i = LBound(TabIn, 1) To UBound(TabIn, 1)
          'Si une ligne de la colonne B est non vide, TabIn(i, 1) sera non vide
          If TabIn(i, 1) <> "" Then
            'on calcule la dernière ligne de la feuille Recap :
            drLigRecap = Sheets("Recap_Quantité").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row
            'on écrit donc en colonne A le nom de la feuille "origine" des données
            Sheets("Recap_Quantité").Range("A" & drLigRecap).Value = fl.Name
            'on copie colle
            .Range("B" & i + 3 & ":G" & i + 3).Copy Sheets("Recap_Quantité").Range("B" & drLigRecap)
          End If
        Next i
      End If
    End With
  End If
Next fl
End Sub

TabIn = .Range("B4:G" & drLigfl)

For i = LBound(TabIn, 1) To UBound(TabIn, 1)