Barre de progression durant suppressions de lignes

Bonjour à tous, et bonne année 2021 à chacun d'entre vous.

Je e permets de vous demander de l'aide, car j'ai un classeur de données avec la feuille "en cours" qui sert de base de travail pour le traitements de près de 3000 lignes.

Je copie toutes les données de cette feuille sur la feuille "Archives", pour ne pas toucher à la feuille "en cours", puis je repère les lignes dont la colonne P n'est pas vide, pour ensuite vider les lignes ou P est vide.

A chaque étape, j'ai créé une barre de progression, respectivement, MaBarre1 et MaBarre2.

La 3e étape est de remonter les lignes restantes en supprimant les lignes vides. Comme je ne maîtrise pas ce type de traitement, j'ai adapté un code retrouvé sur le forum,, il fonctionne bien, mais je n'arrive pas à lui appliquer une barre de progression MaBarre3.

J'ai essayé plusieurs calculs, sans succès. Je pense que la formule de calcul ne colle pas avec le code du traitement des lignes, mais je ne vois pas où.

Je ne peux pas envoyer le fichier, mais je peux vous envoyer le code que j'utilise.

Merci pour toute l'aide que vous pourrez m'apporter.

Cordialement,

Salut Armelito,

loin de moi l'idée de vouloir te faire de la peine mais... tes barres de progression sont, dans ce cas-ci, complètement inutiles..

Dim sWk As Worksheet, lgRow&
'
Set sWk = Worksheets("EnCours")
With Worksheets("Archives")
    Application.ScreenUpdating = False
    '
    If .[A7] <> "" Then .Range("A7:P" & .Range("A" & Rows.Count).End(xlUp).Row).Delete
    lgRow = sWk.Range("A" & Rows.Count).End(xlUp).Row
    If lgRow > 6 Then _
        .Range("A7").Resize(lgRow - 6, 16).Value = sWk.Range("A7").Resize(lgRow - 6, 16).Value: _
        .Range("P7:P" & lgRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlUp: _
        MsgBox "Archivage terminé !"
    '
    Application.ScreenUpdating = True
End With

A+

loin de moi l'idée de vouloir te faire de la peine mais... tes barres de progression sont, dans ce cas-ci, complètement inutiles..

Bonjour curulis57, pas de souci, c'est juste que comme je traite 4000 lignes, je trouvais intéressant qu'on connaisse l'avancée des traitements. En plus, mes barres de progression avaient chacune une couleur spécifique, pour qu'on voie sans difficulté la phase et l'avancée...

Je te remercie pour ton code et ta franchise.

Je viens de le tester, et il fusionne mes colonnes A et B, et bizarrement, les mises en forme conditionnelles ne fonctionnent plus.

Du coup, tu me mets le doute à continuer sur ma lancée, mais j'en suis à vouloir le faire, justement parce ça coince

Salut Armelito,

sans fichier (quelques dizaines de lignes suffisent) mettant en perspective les particularités dont il faut tenir compte, difficile, à l'aveugle, de faire mieux...

- mon code ne fusionne aucune cellule ?!
- comme je Delete la feuille 'Archives' avant traitement, cela efface sans doute les MFC (pas testé ni étudié cette possibilité)

Donc, voici le même code sans Delete.

Dim sWk As Worksheet, lgRow&
'
Set sWk = Worksheets("EnCours")
With Worksheets("Archives")
    Application.ScreenUpdating = False
    '
    If .[A7] <> "" Then .Range("A7:P" & .Range("A" & Rows.Count).End(xlUp).Row).Value = ""
    lgRow = sWk.Range("A" & Rows.Count).End(xlUp).Row
    If lgRow > 6 Then _
        .Range("A7").Resize(lgRow - 6, 16).Value = sWk.Range("A7").Resize(lgRow - 6, 16).Value: _
        .Range("P7:P" & lgRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlUp: _
        MsgBox "Archivage terminé !"
    '
    Application.ScreenUpdating = True
End With

A+

Bonjour curulis57,

Impec, ça marche nickel. La mise en forme et gardée, les cellules ne fusionnent plus, et c'est hyper rapide !

J'ai aussi fusionné mes 2 premières, et le tout réuni, le traitement est bien meilleur.

Merci pour ton aide, et pour le temps que tu m'as consacré.