Bouton archivage qui ne fonctionne qu'une seul fois

Bonjour à tous,

Je viens vers vous car avec l'aide du forum et d'Amadeus nous avions créé un bouton pour un archivage de données. Les premiers test étaient concluants seulement je viens de m'apercevoir que l'archivage n'a fonctionné que la première fois. Je n'es aucune compétence en VBA, je souhaite simplement aidé une association.

Je vous joints le fichier en archive zip (question de poids de fichiers) et d'avance merci pour votre aide.

Bonne fin de journée

Bonsoir,

Je ne cherche pas à optimiser ton code, je t'explique juste ce qui ne va pas dans ta procédure.

Voilà le code :

Sub Archive()
   Dim MaCellule As Object, DerLgn As Variant, i
   For Each MaCellule In Range("Y4", Range("Y4").End(xlDown))
      If MaCellule > 1 And MaCellule.Offset(, 2) = 0 Then
         MaCellule.EntireRow.Copy
         i = MaCellule.Row
         Sheets("Archive Reprises").Activate
         DerLgn = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
         Rows(DerLgn).Select
         ActiveSheet.Paste
         Range("A1").Select
         Sheets("Gestion des reprises-CHEVAUX").Activate
         Rows(i).Select
         Range("E" & i, Range("E" & i).Offset(, 22)).ClearContents
         Range("Z" & i).ClearContents
      End If
   Next MaCellule
   Application.CutCopyMode = False
   Range("A1").Select
End Sub

Ici, après avoir copier la ligne dans la feuille archive, tu cleares de la colonne E jusqu'à la colonne AA (normal ? pas AB ?), donc tu supprimes par la même occasion les cellules contenant des formules :

         Range("E" & i, Range("E" & i).Offset(, 22)).ClearContents

Si tu corriges ton code de cette manière, cela devrait conserver les formules :

Range("E" & i, Range("E" & i).Offset(, 22)).SpecialCells(xlCellTypeConstants).ClearContents

Comme tu as supprimé les formules des lignes remisent à blanc, la formule de la colonne Y a disparue et quand tu archives à nouveau, la boucle s'arrête à la dernière cellule de la colonne Y ayant une formule, donc la ligne 6.

Remplace la ligne :

For Each MaCellule In Range("Y4", Range("Y4").End(xlDown))

Par celle-ci :

For Each MaCellule In Range("Y4", Range("Y" & Rows.Count).End(xlUp))

Tu aurais pu trouver la solution, car tu l'utilises un peu plus loin dans ton code. Privilégie toujours xlUp plutôt que xlDown quand tu veux trouver la dernière ligne ou bien utilise usedrange.rows.count, mais il faut faire attention que la plage commence bien en ligne A. Personnellement j’utilise toujours UsedRange, au besoin je remplis la cellulee A1, pour être sûr de ne pas rencontrer de problème.

Merci Benoît,

Je te remercie de cette réponse rapide et tes explications. Je modifie le code dès demain et te tiens informé.

Bonne journée

Bonjour,

Juste pour vous remercier pour les explications et votre aide précieuse.

La macro fonctionne à merveille.

À bientôt