Copier une ligne entière, si message d'erreur

[laurent21700]

Bonjour,

Je souhaiterai que toutes les lignes de la feuille 1 comportant un message d'erreur en colonne N soit copier automatiquement sur une feuille 4

Merci bcp d'avance,

 

[Efgé]

Re : Copier une ligne entière, si message d'erreur

Bonjour laurent21700

Comme je pense qu'il s'agit de la suite de ta demande d'hier, je te propose un code qui fait les deux.
Feuille3 les erreur 4H, 4D et vide en colonne K
Feuille 4 les #N/A

Sub ventilation_2()
Dim i&, J&, K&, KErr&
Dim T As Variant, TErr As Variant

With Sheets("Feuil1")
    T = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(3)(1, 14))
End With
TErr = T

For i = LBound(T, 1) To UBound(T, 1)
    If T(i, 10) = "4H" Or T(i, 10) = "4D" Or T(i, 11) = "" Then
        If IsError(T(i, 14)) Then
            KErr = KErr + 1
            For J = LBound(T, 2) To UBound(T, 2)
                TErr(KErr, J) = T(i, J)
            Next J
        Else
            K = K + 1
            For J = LBound(T, 2) To UBound(T, 2)
                T(K, J) = T(i, J)
            Next J
        End If
    End If
Next i

If K > 0 Then Sheets("Feuil3").Cells(1, 1).Resize(K, UBound(T, 2)) = T
If KErr > 0 Then Sheets("Feuil4").Cells(1, 1).Resize(KErr, UBound(TErr, 2)) = TErr
    
End Sub

Cordialement

 

[laurent21700]

Re : Copier une ligne entière, si message d'erreur

Parfais !!
merci

 

[laurent21700]

Re : Copier une ligne entière, si message d'erreur

Bonjour,

Les lignes contenant #N/A sont copier en feuille 4 mais que celles qui ont en plus de #N/A " 4D ou 4H, j'aimerai qu'elle ne prenne que les #N/A

Merci bcp d'avance.

 

[Efgé]

Re : Copier une ligne entière, si message d'erreur

Bonjour laurent21700

Quand tu dis "que les #N/A" je comprends "tous les #N/A" :

Sub ventilation_3()
Dim i&, J&, K&, KErr&
Dim T As Variant, TErr As Variant

With Sheets("Feuil1")
    T = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(3)(1, 14))
End With
TErr = T

For i = LBound(T, 1) To UBound(T, 1)
    If IsError(T(i, 14)) Then
        KErr = KErr + 1
        For J = LBound(T, 2) To UBound(T, 2)
            TErr(KErr, J) = T(i, J)
        Next J
    ElseIf T(i, 10) = "4H" Or T(i, 10) = "4D" Or T(i, 11) = "" Then
        K = K + 1
        For J = LBound(T, 2) To UBound(T, 2)
            T(K, J) = T(i, J)
        Next J
    End If
Next i

If K > 0 Then Sheets("Feuil3").Cells(1, 1).Resize(K, UBound(T, 2)) = T
If KErr > 0 Then Sheets("Feuil4").Cells(1, 1).Resize(KErr, UBound(TErr, 2)) = TErr
    
End Sub

Tu aurais pu fournir l'exemple avec la macro

Cordialement