XL 2010 soucis archivage ( entres autres )

bonjour ,
voila , j'ai fait appel à une AI ( Claude) afin de m'aider à créer se fichier concernant les courses de chevaux mais , buggs récurant , en fait dés qu'il touche à quelques choses cela met en vrille autres choses et du coup j'ai perd des mois d'archivages , bref du temps etc etc ....
dernierement je me suis appercus que l'archivage ne se faisait pas correctement concernant les pages " réunion " , a priori seul la page " Réunion 3 " se fait correctement , je dit bien à priori ...malheuresement je ne peut pas télécharger ici le fichier ( trop volumineux ) , donc je vous copie le code VBA qui peut étre sera vous renseigner sur l'erreur ....

' ================================================================
' MODULE : ModuleArchivage v4 - Archivage COMPLET
' ================================================================
Sub SauvegarderFichier()
ThisWorkbook.Save
End Sub
Sub ArchiverReunion1()
Call ArchiverReunion("Réunion1", "Réunion 1")
End Sub
Sub ArchiverReunion2()
Call ArchiverReunion("Réunion2", "Réunion 2")
End Sub
Sub ArchiverReunion3()
Call ArchiverReunion("Réunion3", "Réunion 3")
End Sub
Sub ReinitReunion1()
Call ReinitReunion("Réunion1")
End Sub
Sub ReinitReunion2()
Call ReinitReunion("Réunion2")
End Sub
Sub ReinitReunion3()
Call ReinitReunion("Réunion3")
End Sub
Sub ArchiverReunion(nomFeuille As String, labelReunion As String)
Dim wsR As Worksheet, wsH As Worksheet
Dim nextRow As Long, synRow As Long
Dim courseRow As Long, ptRow As Long
Dim nbArchives As Integer, i As Integer
On Error GoTo ErrHandler
ThisWorkbook.Save
Set wsR = ThisWorkbook.Sheets(nomFeuille)
Set wsH = ThisWorkbook.Sheets("Historique")
wsH.Unprotect Password:=""
nextRow = wsH.Cells(wsH.Rows.Count, "A").End(xlUp).Row + 1
If nextRow < 4 Then nextRow = 4
nbArchives = 0
For synRow = 6 To 42 Step 4
courseRow = synRow - 2
ptRow = synRow - 1
If wsR.Cells(courseRow, 3).Value = "" Then GoTo NextCourse
wsH.Cells(nextRow, 1).Value = wsR.Cells(synRow, 11).Value
wsH.Cells(nextRow, 2).Value = wsR.Cells(1, 4).Value
wsH.Cells(nextRow, 3).Value = wsR.Cells(1, 6).Value
wsH.Cells(nextRow, 4).Value = labelReunion
wsH.Cells(nextRow, 5).Value = wsR.Cells(courseRow - 1, 1).Value
wsH.Cells(nextRow, 6).Value = wsR.Cells(courseRow, 3).Value
wsH.Cells(nextRow, 7).Value = wsR.Cells(courseRow, 4).Value
wsH.Cells(nextRow, 8).Value = wsR.Cells(courseRow, 15).Value
wsH.Cells(nextRow, 9).Value = wsR.Cells(courseRow, 16).Value
wsH.Cells(nextRow, 10).Value = wsR.Cells(courseRow, 17).Value
wsH.Cells(nextRow, 11).Value = wsR.Cells(courseRow, 18).Value
wsH.Cells(nextRow, 12).Value = wsR.Cells(ptRow, 15).Value
wsH.Cells(nextRow, 13).Value = wsR.Cells(ptRow, 17).Value
wsH.Cells(nextRow, 14).Value = wsR.Cells(synRow, 15).Value
wsH.Cells(nextRow, 15).Value = wsR.Cells(synRow, 16).Value
wsH.Cells(nextRow, 16).Value = wsR.Cells(synRow, 17).Value
wsH.Cells(nextRow, 17).Value = wsR.Cells(synRow, 21).Value
wsH.Cells(nextRow, 18).Value = wsR.Cells(synRow, 22).Value
wsH.Cells(nextRow, 19).Value = wsR.Cells(synRow, 23).Value
wsH.Cells(nextRow, 20).Value = wsR.Cells(synRow, 24).Value
wsH.Cells(nextRow, 21).Value = wsR.Cells(synRow, 26).Value
wsH.Cells(nextRow, 22).Value = wsR.Cells(synRow, 27).Value
wsH.Cells(nextRow, 23).Value = wsR.Cells(synRow, 28).Value
wsH.Cells(nextRow, 24).Value = wsR.Cells(synRow, 29).Value
wsH.Cells(nextRow, 25).Value = wsR.Cells(synRow, 30).Value
wsH.Cells(nextRow, 26).Value = wsR.Cells(synRow, 31).Value
wsH.Cells(nextRow, 27).Value = wsR.Cells(synRow, 32).Value
wsH.Cells(nextRow, 28).Value = wsR.Cells(synRow, 33).Value
wsH.Cells(nextRow, 29).Value = wsR.Cells(synRow, 34).Value
wsH.Cells(nextRow, 30).Value = wsR.Cells(synRow, 35).Value
wsH.Cells(nextRow, 31).Value = wsR.Cells(synRow, 36).Value
wsH.Cells(nextRow, 32).Value = wsR.Cells(synRow, 37).Value
wsH.Cells(nextRow, 33).Value = wsR.Cells(synRow, 38).Value
wsH.Cells(nextRow, 34).Value = wsR.Cells(ptRow, 19).Value
wsH.Cells(nextRow, 35).Value = wsR.Cells(ptRow, 22).Value
wsH.Cells(nextRow, 36).Value = wsR.Cells(synRow, 19).Value
wsH.Cells(nextRow, 37).Value = wsR.Cells(synRow, 22).Value
For i = 1 To 8
wsH.Cells(nextRow, 37 + i).Value = wsR.Cells(courseRow, 2 + i).Value
Next i
For i = 1 To 8
wsH.Cells(nextRow, 45 + i).Value = wsR.Cells(ptRow, 2 + i).Value
Next i
For i = 1 To 8
wsH.Cells(nextRow, 53 + i).Value = wsR.Cells(synRow, 2 + i).Value
Next i
nbArchives = nbArchives + 1
nextRow = nextRow + 1
NextCourse:
Next synRow
wsH.Protect Password:=""
If nbArchives > 0 Then
MsgBox nbArchives & " course(s) archivee(s) !", vbInformation, "Archivage OK"
Else
MsgBox "Aucune donnee a archiver.", vbExclamation, "Rien a archiver"
End If
Exit Sub
ErrHandler:
wsH.Protect Password:=""
MsgBox "Erreur : " & Err.Description, vbCritical, "Erreur archivage"
End Sub
Sub ReinitReunion(nomFeuille As String)
If MsgBox("Effacer toutes les saisies de " & nomFeuille & " ?", vbYesNo + vbQuestion, "Confirmer") = vbNo Then Exit Sub
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(nomFeuille)
ws.Unprotect Password:=""
Dim r As Long
For r = 4 To 40 Step 4
ws.Range(ws.Cells(r, 3), ws.Cells(r, 10)).ClearContents
ws.Range(ws.Cells(r + 1, 3), ws.Cells(r + 1, 10)).ClearContents
ws.Cells(r, 15).ClearContents
ws.Cells(r, 16).ClearContents
ws.Cells(r, 17).ClearContents
ws.Cells(r, 18).ClearContents
ws.Cells(r + 1, 15).ClearContents
ws.Cells(r + 1, 16).ClearContents
ws.Cells(r + 1, 19).ClearContents
ws.Cells(r + 2, 19).ClearContents
Next r
Call RestaurerSyntheses(ws)
ws.Protect Password:=""
MsgBox nomFeuille & " reinitialisee !", vbInformation, "OK"
End Sub
Sub RestaurerSyntheses(ws As Worksheet)
Dim syn As Long, col As Long, idx As Integer
Dim zt As Long, pt As Long
For syn = 6 To 42 Step 4
zt = syn - 2: pt = syn - 1
For col = 3 To 10
idx = col - 2
ws.Cells(syn, col).Formula = _
"=IFERROR(IF(ISNUMBER(MATCH(LARGE(AT" & syn & ":BJ" & syn & "," & idx & "),AT" & syn & ":BA" & syn & ",0))," & _
"INDEX(C" & zt & ":J" & zt & ",MATCH(LARGE(AT" & syn & ":BJ" & syn & "," & idx & "),AT" & syn & ":BA" & syn & ",0))," & _
"INDEX(C" & pt & ":J" & pt & ",MATCH(LARGE(AT" & syn & ":BJ" & syn & "," & idx & "),BB" & syn & ":BI" & syn & ",0))),"""")"
Next col
ws.Cells(zt, 12).Formula = "=IF(C" & syn & "="""","""",C" & syn & ")"
ws.Cells(zt, 13).Formula = "=IF(D" & syn & "="""","""",D" & syn & ")"
Next syn
End Sub
Sub ArchiverQuinte()
Dim wsQ As Worksheet, wsAQ As Worksheet
Dim nextRow As Long, j As Integer
On Error GoTo ErrHandler
ThisWorkbook.Save
Set wsQ = ThisWorkbook.Sheets("Quinté+")
Set wsAQ = ThisWorkbook.Sheets("Archive Quinté")
nextRow = wsAQ.Cells(wsAQ.Rows.Count, "A").End(xlUp).Row + 1
If nextRow < 2 Then nextRow = 2
If wsQ.Cells(2, 2).Value = "" Then
MsgBox "Aucun prono saisi dans Quinté+", vbExclamation, "Rien a archiver"
Exit Sub
End If
For j = 1 To 8
wsAQ.Cells(nextRow, j).Value = wsQ.Cells(2, 1 + j).Value
Next j
For j = 1 To 8
wsAQ.Cells(nextRow, 8 + j).Value = wsQ.Cells(3, 1 + j).Value
Next j
For j = 1 To 8
wsAQ.Cells(nextRow, 16 + j).Value = wsQ.Cells(4, 1 + j).Value
Next j
For j = 1 To 8
wsAQ.Cells(nextRow, 24 + j).Value = wsQ.Cells(5, 1 + j).Value
Next j
wsAQ.Cells(nextRow, 33).Value = wsQ.Cells(8, 4).Value
wsAQ.Cells(nextRow, 34).Value = wsQ.Cells(8, 5).Value
wsAQ.Cells(nextRow, 35).Value = wsQ.Cells(8, 6).Value
wsAQ.Cells(nextRow, 36).Value = wsQ.Cells(8, 7).Value
wsAQ.Cells(nextRow, 37).Value = wsQ.Cells(8, 8).Value
MsgBox "Quinté+ archivé ! Ligne " & nextRow & ".", vbInformation, "Archivage OK"
Exit Sub
ErrHandler:
MsgBox "Erreur : " & Err.Description, vbCritical, "Erreur archivage"
End Sub
Sub GenererTicketQuinte()
Dim wsQ As Worksheet
Set wsQ = ThisWorkbook.Sheets("Quinté+")
wsQ.Calculate
MsgBox "Ticket généré !", vbInformation, "Ticket Quinté+"
End Sub





merci d'avance