XL 2010 récupération de données dans plusieurs feuilles qui s'incrémente au fur et à mesure

Sub Récap()

     Select Case [A5]    'A5 : la cellule contenant la durée du stage
          Case "7H"
               'à développer
          Case "21H"
               Récap_21
          Case "56H"
               'à développer
          Case "76H"
               'à développer
     End Select
    
End Sub


Sub Récap_21()
    
     'Nom de la feuille Récap (Cible)
     Const Nom_Cible = "Recap 21H"
     'Colonne de la feuille cible contenant les formats à recopier
     Const Col_Modèle = 2
    
     'Plages de données Source pour les stages 21 heures
     Const S_Général_21 As String = "$B$8:$B$10"
     Const S_Jour1_21 As String = "$B$14:$B$22"
     Const S_Jour2_21 As String = "$B$26:$B$35"
     Const S_Jour3_21 As String = "$B$39:$B$42"
    
     'Plages de données Cibles pour les stages 21 heures (la 1ère colonne)
     Const C_L_Titre As Long = 6
     Const C_Général_21 As String = "$A$7:$A$9"
     Const C_Jour1_21 As String = "$A$11:$A$19"
     Const C_Jour2_21 As String = "$A$21:$A$30"
     Const C_Jour3_21 As String = "$A$32:$A$35"
    
     Dim Wsh_C As Worksheet, Wsh_S As Worksheet
     Set Wsh_C = ThisWorkbook.Worksheets(Nom_Cible)
    
     Set Wsh_S = ActiveSheet
     Nom_Promo = Wsh_S.Name
    
     Décalage = WorksheetFunction.CountA(Wsh_C.Rows(C_L_Titre))
    
     'Nom de la feuille source
     Wsh_C.Cells(C_L_Titre, Décalage + 1).Value = Nom_Promo
     'Lien hypertexte vers cette feuille
     Wsh_C.Hyperlinks.Add Anchor:=Wsh_C.Cells(C_L_Titre, Décalage + 1), Address:="", SubAddress:="'" & Nom_Promo & "'!A1", TextToDisplay:=Nom_Promo
    
     'Recopie des valeurs
     Wsh_C.Evaluate(C_Général_21).Offset(0, Décalage).Value = Wsh_S.Evaluate(S_Général_21).Value
     Wsh_C.Evaluate(C_Jour1_21).Offset(0, Décalage).Value = Wsh_S.Evaluate(S_Jour1_21).Value
     Wsh_C.Evaluate(C_Jour2_21).Offset(0, Décalage).Value = Wsh_S.Evaluate(S_Jour2_21).Value
     Wsh_C.Evaluate(C_Jour3_21).Offset(0, Décalage).Value = Wsh_S.Evaluate(S_Jour3_21).Value
    
     'Recopie des formats
     Wsh_C.Columns(Col_Modèle).Copy
     Wsh_C.Columns(Col_Modèle).Resize(, Décalage).PasteSpecial xlPasteFormats
    
     'Style Hypertexte
     Wsh_C.Cells(C_L_Titre, Col_Modèle).Offset(0, 1).Resize(, Décalage - 1).Style = "Hyperlink"
    
End Sub

Sub Récap()

Dim Feuille, Source, Cible
     Select Case [A5]    'A5 : la cellule contenant la durée du stage
          Case "7H"
               'à développer
          Case "21H"
               Feuille = "Recap 21H"
               Source = Array("$B$8:$B$10", "$B$14:$B$22", "$B$26:$B$35", "$B$39:$B$42")
               Cible = Array("$A$7:$A$9", "$A$11:$A$19", "$A$21:$A$30", "$A$32:$A$35")
          Case "56H"
               'à développer
          Case "76H"
               'à développer
     End Select
    
     Consolider Feuille, Source, Cible
    
End Sub

Sub Consolider(Feuille, Source, Cible)
    
     Const C_L_Titre As Long = 6   'N° ligne d'entête dans la feuille cible
     Const Col_Modèle = 2          'N° de la colonne de la feuille cible contenant les formats à recopier (colonne Moyenne)
     Dim Wsh_C As Worksheet, Wsh_S As Worksheet
     Dim Nom_Promo As String, Décalage As Integer, i As Integer
    
     Application.ScreenUpdating = False
    
     Set Wsh_C = ThisWorkbook.Worksheets(Feuille)
    
     Set Wsh_S = ActiveSheet
     Nom_Promo = Wsh_S.Name
    
     Décalage = WorksheetFunction.CountA(Wsh_C.Rows(C_L_Titre))
    
     'Nom de la feuille source
     Wsh_C.Cells(C_L_Titre, Décalage + 1).Value = Nom_Promo
     'Lien hypertexte vers cette feuille
     Wsh_C.Hyperlinks.Add Anchor:=Wsh_C.Cells(C_L_Titre, Décalage + 1), Address:="", _
                                                                        SubAddress:="'" & Nom_Promo & "'!A1", _
                                                                        TextToDisplay:=Nom_Promo, _
                                                                        ScreenTip:="Voir la fiche complète"
     'Recopie des valeurs
     For i = LBound(Source) To UBound(Source)         
          Wsh_C.Range(Cible(i)).Offset(0, Décalage).Value = Wsh_S.Range(Source(i)).Value
     Next

     'Recopie des formats
     Wsh_C.Columns(Col_Modèle).Copy
     Wsh_C.Columns(Col_Modèle).Resize(, Décalage).PasteSpecial xlPasteFormats
    
     'Style Hypertexte (effacé par la recopie des formats)
     Wsh_C.Cells(C_L_Titre, Col_Modèle).Offset(0, 1).Resize(, Décalage - Col_Modèle + 1).Style = "Hyperlink"
    
     Application.ScreenUpdating = True
    
End Sub