Macro Archivage

Bonjour,

Après plusieurs jours à travailler sur cette macro sans résultat (je débute le vba sur cette macro), je m'en remet à la charmante communauté de ce forum !

Créer une macro activable par un bouton uniquement si elle remplit la condition suivante :

Que les cases de la colonne G contiennent ce qui est spécifié en case A12 de la feuille 2, (à savoir « 9-TERMINER »).

Cette macro est la suivante :

Macro :

• Sélectionner les cellules C D E F H (Si les conditions sont remplis (« 9-TERMINER » dans la colonne G)
• Les copier/coller dans la feuille d’archive, en allant à la prochaine ligne vide dans cette même feuille.
• Effacer la ligne entière des cellules sélectionnées sans effacer la mise en forme.

N'hésitez pas à me contacter pour de plus amples informations,

En vous remerciant d'avance,

George Corseret

Bonsoir,

Peux-tu :

• Confirmer que seules les cellules en col. C, D, E, F et H de chaque ligne sont concernées pour les lignes marquées par la mention TERMINER en G.
• Placer le bouton avec lequel tu veux lancer ta macro.
• Mettre une ligne d'en-tête sur la feuille Archive.

Cordialement.

Merci pour la rapidité de ta réponse !

En effet c'est uniquement les cellules en colonne C, D, E, F et H possédant la mention 9- TERMINER en G qui sont concernées.

J'ai mis à jour mon fichier

Cordialement,

Bonjour,

A tester :

Sub Archiver()
    Dim TArch(), n%, i%, j%, k%
    With Worksheets("Tableau")
        Application.ScreenUpdating = False
        n = .Cells(.Rows.Count, 7).End(xlUp).Row
        For i = 7 To n
            If .Cells(i, 7) = "9 - TERMINER" Then
                j = j + 1: ReDim Preserve TArch(1 To 5, 1 To j)
                For k = 3 To 6
                    TArch(k - 2, j) = .Cells(i, k)
                Next k
                TArch(5, j) = .Cells(i, 8)
                .Cells(i, 1).Resize(, 11).ClearContents
            End If
        Next i
        .Range("A7:K" & n).Sort key1:=.Cells(7, 7), order1:=xlAscending, Header:=xlNo
        Application.ScreenUpdating = True
    End With
    With Worksheets("Archive")
        n = 0
        For k = 1 To 5
            j = .Cells(.Rows.Count, k).End(xlUp).Row
            n = IIf(j > n, j, n)
        Next k
        .Cells(n + 1, 1).Resize(UBound(TArch, 2), 5).Value = WorksheetFunction.Transpose(TArch)
    End With
End Sub

NB- N'étant pas garanti que les 5 valeurs à archiver par ligne soient toutes saisies lors de l'archivage,la détermination de la première ligne à utiliser sur Archive tient compte de toutes les colonnes (par sécurité).

La méthode ne procède pas par copier-coller, mais par constitution d'un tableau, affecté globalement...

Les lignes archivées sont effacées, et le tableau est retrié sur la colonne G.

Cordialement.

Merci beaucoup je test cela demain je vous tiens au courant si ça fonctionne !

Un grand merci bonne soirée !