Ajout d'une condition macro existante

Bonjour à tous !

Je suis à la recherche de la ligne qui me permettra d'ajouter une condition à ma macro d'archivage.

Ma macro actuelle se base sur deux variables pour archiver ma ligne dans un autre onglet.

Or je voudrais y ajouter une troisième qui est la suivante :

Dans ma colonne H, je dois remplir des dates du type "jj/mm/aaaaa", je voudrais que ma ligne ne s'archive que si la cellule H de ma ligne est pleine et qu'elle est rempli par une date "jj/mm/aaaa".

Je vous joint la macro actuelle :

Sub Archiver_Audit()

    For ln = Range("B" & Rows.Count).End(xlUp).Row To 3 Step -1
        Set cell = Range("F" & ln).Find("100%", lookat:=xlPart)
        If Not cell Is Nothing Then
            If Range("I" & ln) = "Archive" Then
                Sheets("Archive AG").Rows("2:2").Insert shift:=xlDown
                Range("A" & ln & ":J" & ln).Copy Sheets("Archive AG").Range("A5")
                Sheets("Archive AG").Rows("2:2").EntireRow.AutoFit
                Rows(ln & ":" & ln).Delete shift:=xlUp
            End If
        End If
    Next ln
End Sub

Si besoin, pour plus de compréhension, je vous joindrai le fichier excel.

Cordialement

Bonjour,

A tester :

Sub Archiver_Audit()

    For ln = Range("B" & Rows.Count).End(xlUp).Row To 3 Step -1
        Set cell = Range("F" & ln).Find("100%", lookat:=xlPart)
        If Not cell Is Nothing Then
           If Range("I" & ln) = "Archive" and isDate(Range("H" & ln)) Then
                Sheets("Archive AG").Rows("2:2").Insert shift:=xlDown
                Range("A" & ln & ":J" & ln).Copy Sheets("Archive AG").Range("A5")
                Sheets("Archive AG").Rows("2:2").EntireRow.AutoFit
                Rows(ln & ":" & ln).Delete shift:=xlUp
            End If
        End If
    Next ln
End Sub

Bonjour Jean-Eric,

Merci du temps que tu prends pour mon problème.

Toutefois, je ne peux vérifier si la macro marche car j'ai un problème de débogage que je n'arrive pas à résoudre

Je te joint le fichier excel en PJ, si tu veux bien y jeter un œil.

 Sub Archiver_ISO()

    For ln = Range("B" & Rows.Count).End(xlUp).Row To 3 Step -1
        Set cell = Range("F" & ln).Find("100%", lookat:=xlPart)
        If Not cell Is Nothing Then
            If Range("I" & ln) = "Archive" And IsDate(Range("H" & ln)) Then
                Sheets("Archive ISO").Rows("2:2").Insert shift:=xlDown
                Range("A" & ln & ":J" & ln).Copy Sheets("Archive ISO").Range("A6")
                Sheets("Archive ISO").Rows("2:2").EntireRow.AutoFit
                Rows(ln & ":" & ln).Delete shift:=xlUp
            End If
        End If
    Next ln
End Sub

J'agis sur l'onglet ISO 14001, et à chaque tentative, j'ai cette ligne qui se surligne.

En espérant que tu puisses m'aider,

Cordialement

Re,

A quoi sert cette ligne?

Sheets("Archive ISO").Rows("2:2").Insert shift:=xlDown

Cette ligne permet à mon action archiver d'être en tête de tableau une fois l'action effectué, si je ne me trompe pas.

Tu peux faire le test avec l'onglet Action Global.

La macro y est également, mais sans la condition supplémentaire et cela marche très bien.

Je crois avoir trouver, en effet je dois modifier le Rows("2:2") par "6:6" car quand j'ai effectué ma macro sur l'onglet Action global, la première ligne était celle avec Lot, Action, etc...

Et entre temps j'ai ajouté la mise en forme, donc ajout de ligne, mais la macro me l'a reconnait toujours comme tel.

Or ici j'ai déjà ajouté mes lignes, et ensuite intégré ma macro !

Merci pour ton aide !