Copier un tableau dans une centaine de feuilles et créer des liens hypertextes automa

Sub InsertSout() 'change la chaine de caract des soutiens dans la liste des élèves car la liste des soutiens évolue
Dim L As Long, Sinsert As String, Sout As String, PlgSout As Range, Z As String, P As Long, C As String, k As Integer, 
Sinsert = TbxInsert.Text
For L = 2 To FLstÉlv.Range("A65536").End(xlUp).Row       ' dernière ligne non vide
    Set PlgSout = FLstÉlv.[Soutiens].Rows(L)
    Z = PlgSout.Value
    If Not Z = "" Then
        For k = Len(Z) - 2 To 1 Step -3
            If Val(Mid$(Z, k, 2)) > Val(Sinsert) Then
                C = Mid$(Z, k, 2)
                C = C + 1
                If Len(C) = 1 Then C = "0" & C
                Z = Left$(Z, k - 1) & C & Mid$(Z, k + 2)
            End If
         Next k
    End If
    FLstÉlv.[Soutiens].Rows(L) = Z
Next L
End Sub

C = Mid$(Z, k, 2): If C > SInsert Then Mid$(Z, K, 2) = Format(C + 1, "00")

Private Sub CalcOralMoy()
Dim j As Integer, Oralmoy, Tot
j = 0
Tot = 0
If IsNumeric(TbxO_1.Text) = True And TbxO_1.Text <> "" Then
j = j + 1
Tot = Tot + Val(TbxO_1.Text)
End If
If IsNumeric(TbxO_2.Text) = True And TbxO_2.Text <> "" Then
j = j + 1
Tot = Tot + Val(TbxO_2.Text)
End If
If IsNumeric(TbxO_3.Text) = True And TbxO_3.Text <> "" Then
j = j + 1
Tot = Tot + Val(TbxO_3.Text)
End If
If IsNumeric(TbxO_4.Text) = True And TbxO_4.Text <> "" Then
j = j + 1
Tot = Tot + Val(TbxO_4.Text)
End If
If IsNumeric(TbxO_5.Text) = True And TbxO_5.Text <> "" Then
j = j + 1
Tot = Tot + Val(TbxO_5.Text)
End If
If IsNumeric(TbxO_6.Text) = True And TbxO_6.Text <> "" Then
j = j + 1
Tot = Tot + Val(TbxO_6.Text)
End If
If j > 0 Then Oralmoy = Tot / j
If ActiveWorkbook.Name Like "*1*" Then TbxOralMoy1 = Oralmoy
If ActiveWorkbook.Name Like "*2*" Then TbxOralMoy2 = Oralmoy
If ActiveWorkbook.Name Like "*3*" Then TbxOralMoy3 = Oralmoy
End Sub

Option ExplicitDim LÉlv As Long, PlgComp As Range, ColComp As Long, Comp As String, ChaineComp As String


Private Sub ChercheRangeCompElv() 'cherche la chaine de caractères dans FlstElv de la Compétence choisie pour l'élève choisi
LÉlv = FCtrl.[LgnÉlv].Value
Comp = FCtrl.[CompSél].Value
If Comp = "" Then
   MsgBox "Aucune compétence n'est sélectionnée", vbCritical, "Modification des compétences"
   Exit Sub
End If


ColComp = FLstÉlv.Cells.Find(What:=Comp).Column    ' d abord faire trouver la colonne de la compétence


Set PlgComp = FLstÉlv.Columns(ColComp).Rows(LÉlv)
ChaineComp = PlgComp.Value       'la chaine de caract de la compétence pour l eleve donné
End Sub


Private Sub ListerRésultatClasse()
Dim TLC As Range, Lign As Long, dL As Long, L As Long
UfComp.LbxRésultClasse.Clear
Set TLC = FLstÉlv.[TouteLaClasse]
dL = TLC.Row - 1
For L = 1 To TLC.Rows.Count
   Lign = L + dL
 If Comp = "" Then UfComp.LbxRésultClasse.AddItem FLstÉlv.[Prénom].Rows(Lign).Value
 If Comp <> "" Then UfComp.LbxRésultClasse.AddItem FLstÉlv.[Prénom].Rows(Lign).Value & "     " & FLstÉlv.Columns(ColComp).Rows(Lign).Value
Next L
End Sub


Private Sub BtSélA_Click()
ChercheRangeCompElv
On Error Resume Next
ChaineComp = ChaineComp + "A"
PlgComp.Value = ChaineComp
ListerRésultatClasse
End Sub


Private Sub BtSélB_Click()
ChercheRangeCompElv
On Error Resume Next
ChaineComp = ChaineComp + "B"
PlgComp.Value = ChaineComp
ListerRésultatClasse
End Sub


Private Sub BtSélC_Click()
ChercheRangeCompElv
On Error Resume Next
ChaineComp = ChaineComp + "C"
PlgComp.Value = ChaineComp
ListerRésultatClasse
End Sub


Private Sub BtSélD_Click()
ChercheRangeCompElv
On Error Resume Next
ChaineComp = ChaineComp + "D"
PlgComp.Value = ChaineComp
ListerRésultatClasse
End Sub


Private Sub ListBox172_Click()   'cette procédure ne fonctionne pas comme je le voudrais, mais avec un temps de retard, car s' affichent les résultats de l'item cliqué précédemment mais pas présentement, dans la fiche ctrl s'est bien le bon CompSél qui est affiché mais la procédure travaille avec l'ancien....why?
ChercheRangeCompElv
On Error Resume Next
PlgComp.Value = ChaineComp
ListerRésultatClasse
End Sub


'Private Sub ListBox172_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 'le même code qu'au dessus ici fonctionne parfaitement pourquoi ça marche ici et pas au dessus avec click????


'End Sub