Help : macro de copie de données et de regroupement d'informations

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim COL As Integer 'déclare la variable COL (COLonne)
Dim RC As Worksheet 'déclare la variable RC (onglet RéCap)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI (LIgne)

Set RC = Sheets("Récap") 'définit l'onglet RC
For Each O In Sheets 'boucle 1 : sur tous les onglets O du classeur
    Select Case O.Name 'agit en fontion du nom de l'onglet
        Case "Janvier"
            COL = 3 'définit la colonne COL
        Case "Février"
            COL = 15 'définit la colonne COL
        Case "Mars"
            COL = 27 'définit la colonne COL
        Case "Avril"
            COL = 39 'définit la colonne COL
        Case "Mai"
            COL = 51 'définit la colonne COL
        Case "Juin"
            COL = 63 'définit la colonne COL
        Case "Juillet"
            COL = 75 'définit la colonne COL
        Case "Août" 'attention j'ai renommé lónglet avec l'accent (û)
            COL = 87 'définit la colonne COL
        Case "Septembre"
            COL = 99 'définit la colonne COL
        Case "Octobre"
            COL = 11 'définit la colonne COL
        Case "Novembre"
            COL = 123 'définit la colonne COL
        Case "Décembre"
            COL = 135 'définit la colonne COL
        Case "Recap"
            GoTo suite 'va à l'étiquette "suite"
    End Select 'fin de l'action en fonction du non de l'onglet
    TV = O.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes du tableau des valeurs (en partant de la seconde)
        Set R = RC.Columns("A").Find(TV(I, 1), , xlValues, xlWhole) 'définit la recherche R (Recherche dans la colonne A de Récap la valeur entière de TV(I,1))
        If Not R Is Nothing Then 'condition : si au moins une occurrence est trouvée
            LI = R.Row 'définit la ligne LI (ligne de la première occurrence trouvée)
        Else 'sinon
            LI = RC.Range("A" & Application.Rows.Count).End(xlUp).Row + 1 'définit la ligne LI (première ligne vide de la colonne A de Récap)
        End If 'fin de la condition
        RC.Cells(LI, 1).Value = TV(I, 1) 'place le nom dans la colonne A de Récap
        RC.Cells(LI, 2).Value = TV(I, 2) 'place le prénom dans la colonne A de Récap
        For J = 0 To 10 'boucle 3 : de 0 à 10
            RC.Cells(LI, COL + J).Value = TV(I, J + 3) 'renvoie la donnée du tableau TV dans la colonne COL + J de Récap
        Next J 'prochaine colonne de la boucle 3
    Next I 'prochaine ligne de la boucle 2
suite: 'étiquette
Next O 'prochain onglet de la boucle 1
End Sub

' classeur
Dim Shd As Worksheet, ShR As Worksheet
Dim MonTab As Variant, Compt1 As Long

Sub copyData()
Dim Pas As Integer
Pas = 12 ' a modifier
Set ShR = Worksheets("Récap")

For Each Shd In Worksheets
    Select Case Shd.Name
        Case "Janvier"
            MoisNom Shd, 3
        Case "Février"
            MoisNom Shd, (3 + Pas)
        Case "Mars"
            MoisNom Shd, (3 + 2 * Pas)
        Case "Avril"
            MoisNom Shd, (3 + 3 * Pas)
        Case "Mai"
            MoisNom Shd, (3 + 4 * Pas)
        Case "Juin"
            MoisNom Shd, (3 + 5 * Pas)
        Case "Juillet"
            MoisNom Shd, (3 + 6 * Pas)
        Case "Aout"
            MoisNom Shd, (3 + 7 * Pas)
        Case "Septembre"
            MoisNom Shd, (3 + 8 * Pas)
        Case "Octobre"
            MoisNom Shd, (3 + 9 * Pas)
        Case "Novembre"
            MoisNom Shd, (3 + 10 * Pas)
        Case "Décembre"
            MoisNom Shd, (3 + 11 * Pas)
    End Select
Next Shd
End Sub


Private Function RechercheLigne(Nom As String, Prenom As String) As Long
RechercheLigne = 0
With ShR
Set Plg1 = .Range("A1:B" & .Range("a" & .Rows.Count).End(xlUp).Row)
MonTab = Plg1.Value
For Compt1 = LBound(MonTab, 1) To UBound(MonTab, 1)
    If MonTab(Compt1, 1) = Nom And MonTab(Compt1, 2) = Prenom Then
         RechercheLigne = Compt1
         Exit Function
    End If
Next Compt1
End With
End Function

Private Sub MoisNom(Shd As Worksheet, Colonne As Long)
Dim Cellule1 As Range, Plg1 As Range, Lig As Long
With Shd
    
For Each Cellule1 In .Range("a2:a" & .Range("a" & .Rows.Count).End(xlUp).Row)
    Lig = RechercheLigne(CStr(Cellule1.Value), CStr(Cellule1.Offset(0, 1).Value))
   If Lig = 0 Then 'ajout
        Dl1 = ShR.Range("A" & Rows.Count).End(xlUp).Row + 1
        ShR.Range("a" & Dl1) = Cellule1
        ShR.Range("b" & Dl1) = Cellule1.Offset(0, 1)
        Lig = Dl1
        .Range(Cellule1.Offset(0, 2).Address(0, 0) & ":M" & Cellule1.Row).copy _
        Destination:=ShR.Cells(Lig, Colonne)
   Else
   .Range(Cellule1.Offset(0, 2).Address(0, 0) & ":M" & Cellule1.Row).copy _
   Destination:=ShR.Cells(Lig, Colonne)
   End If
Next Cellule1
End With
End Sub

If MonTab(Compt1, 1) = Nom And MonTab(Compt1, 2) = Prenom Then