Copie d'une ligne vers une autre feuille selon condition

[JeanMikael]

Re-bonjour à tous et à toutes j'ai encore besoin de vos lumières
Alors voilà mon problème, j'effectue certaines comparaison dans des colonnes et si je trouve une erreur ma macro indique quelques colonnes plus loin sur la meme ligne l'endroit ou il y a l'erreur n'étant pas satisfait de cette macro pour un soucil de lisibilité (+ de 20000 lignes comparées)j'aimerai donc a la place d'écrire dans la même feuille les erreurs, copié les lignes ou les erreurs ont été trouvé dans une nouvelle feuille sachant que je veux copier toutes la ligne concernée c'est à dire dans mon cas de la colonne "A:AD" si vous pouvez me donné une piste ou autre je vous en serait très reconnaissant, d'avance merci pour vos futurs réponses

Cordialement
Jean-Mikaël

[Catrice]

Bonjour,

Sans le code pas facile de répondre ...

Si ta macro scanne la colonne A tu peux adapter :
X.Resize(1, 30).Copy (Destination)
Où X est la cellule que tu testes et Destination l'enroit ou tu veux coller.


En utilisant par exemple d'une boucle du style
For Each X In Range(Range("A1"), Range("A1").End(xlDown))
X.Resize(1, 30).Copy (Destination)
Next

[JeanMikael]

Oulà étant débutant tout sa c'est un peu flou je te passe mon code de comparaison si tu as le courage de m'aider
Merci beaucoup pour les piste que tu m'a donné


Sub Comparaison()

Application.ScreenUpdating = False

Dim x As Long
Dim y As Long
Dim limite As Long
Dim MaValeur, nbcell
Dim plage As Range
Dim Cel As Range
Dim n As Long
Dim cell As Range


For y = 3 To 65536
If Cells(y, 1) = "" Then
limite = y
Exit For
End If


For x = 3 To y
If (Cells(x, "M") <> 0) Then
If (Cells(x, "U") <> 0) Then Cells(x, "AG") = "Pas D'Erreur" Else Cells(x, "AG") = "Erreur"
Else: Cells(x, "AG") = "Pas D'Erreur"

End If
Next x
Next y

For y = 3 To 65536
If Cells(y, 1) = "" Then
limite = y
Exit For
End If


For x = 3 To y
If (Cells(x, "N") <> 0) Then
If (Cells(x, "V") <> 0) Then Cells(x, "AH") = "Pas D'Erreur" Else Cells(x, "AH") = "Erreur"
Else: Cells(x, "AH") = "Pas D'Erreur"

End If
Next x
Next y

For y = 3 To 65536
If Cells(y, 1) = "" Then
limite = y
Exit For
End If


For x = 3 To y
If (Cells(x, "O") <> 0) Then
If (Cells(x, "W") <> 0) Then Cells(x, "AI") = "Pas D'Erreur" Else Cells(x, "AI") = "Erreur"
Else: Cells(x, "AI") = "Pas D'Erreur"

End If
Next x
Next y


For y = 3 To 65536
If Cells(y, 1) = "" Then
limite = y
Exit For
End If


For x = 3 To y
If (Cells(x, "P") <> 0) Then
If (Cells(x, "X") <> 0) Then Cells(x, "AJ") = "Pas D'Erreur" Else Cells(x, "AJ") = "Erreur"
Else: Cells(x, "AJ") = "Pas D'Erreur"

End If
Next x
Next y

For y = 3 To 65536
If Cells(y, 1) = "" Then
limite = y
Exit For
End If

For x = 3 To y
If (Cells(x, "Q") <> 0) Then Cells(x, "AK") = "Pas D'Erreur" Else Cells(x, "AK") = "Erreur"
Next x
Next y

For y = 3 To 65536
If Cells(y, 1) = "" Then
limite = y
Exit For
End If

For x = 3 To y
If (Cells(x, "R") <> 0) Then Cells(x, "AL") = "Pas D'Erreur" Else Cells(x, "AL") = "Erreur"
Next x
Next y

For y = 3 To 65536
If Cells(y, 1) = "" Then
limite = y
Exit For
End If

For x = 3 To y
If (Cells(x, "S") <> 0) Then Cells(x, "AM") = "Pas D'Erreur" Else Cells(x, "AM") = "Erreur"
Next x
Next y

For y = 3 To 65536
If Cells(y, 1) = "" Then
limite = y
Exit For
End If

For x = 3 To y
If (Cells(x, "T") <> 0) Then Cells(x, "AN") = "Pas D'Erreur" Else Cells(x, "AN") = "Erreur"
Next x
Next y

For nbcell = 2 To 2
Range("AG" & nbcell).Select
MaValeur = ActiveCell.Value
ActiveCell.Value = MaValeur + "Erreur Pour ParcN"
Range("AH" & nbcell).Select
ActiveCell.Value = MaValeur + "Erreur Pour ParcN-1"
Range("AI" & nbcell).Select
ActiveCell.Value = MaValeur + "Erreur Pour ParcN-2"
Range("AJ" & nbcell).Select
ActiveCell.Value = MaValeur + "Erreur Pour ParcN-3"
Range("AK" & nbcell).Select
ActiveCell.Value = MaValeur + "Erreur Pour Parc"
Range("AL" & nbcell).Select
ActiveCell.Value = MaValeur + "Erreur Pour Trn-1"
Range("AM" & nbcell).Select
ActiveCell.Value = MaValeur + "Erreur Pour Trn-2"
Range("AN" & nbcell).Select
ActiveCell.Value = MaValeur + "Erreur Pour Trn-3"

Next

For Each cell In Range("AG:AN")
Select Case cell.Value
Case Is = "Erreur"
cell.Interior.ColorIndex = 3
Case Is = "Pas D'Erreur"
cell.Interior.ColorIndex = 6
Case Is = "Erreur Pour ParcN"
cell.Interior.ColorIndex = 33
Case Is = "Erreur Pour ParcN-1"
cell.Interior.ColorIndex = 33
Case Is = "Erreur Pour ParcN-2"
cell.Interior.ColorIndex = 33
Case Is = "Erreur Pour ParcN-3"
cell.Interior.ColorIndex = 33
Case Is = "Erreur Pour Parc"
cell.Interior.ColorIndex = 33
Case Is = "Erreur Pour Trn-1"
cell.Interior.ColorIndex = 33
Case Is = "Erreur Pour Trn-2"
cell.Interior.ColorIndex = 33
Case Is = "Erreur Pour Trn-3"
cell.Interior.ColorIndex = 33

End Select

Next


'On travaille sur la feuille 1
Set plage = Application.Sheets(1).Range("AF:AN") 'on cherche dans la plage AF:AN
n = 0
For Each Cel In plage
If Cel.Interior.ColorIndex = 3 Then 'la couleur rouge
n = n + 1 'compteur
End If
Next
MsgBox "" & n & " Erreurs Trouvées."
MsgBox "Traitement terminé"


Application.ScreenUpdating = True

End Sub

[Robert]

Bonjour JeanMikael, bonjour le forum,

Ça serait plus sympa d'avoir le bout de code te ta mocro au départ pour savoir quels sont les critères qui permettent de trouver l'erreur et y integrer les codes d'une extraction... Non ?

Sinon souvent je fais comme ça :

Sub Macro1()
 
Dim cel As Range 'déclare la variable cel
Dim dest As Range 'déclare la variable dest
 
'boucle sur les cellules pouvant contenir l'erreur
For Each cel In Range("ta_plage")
 
    'condition : si la valeur de la cellule contieint l'erreur
    If cel.Value = "ton_erreur" Then
        Set dest = Sheets("Feuil2").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
        cel.EntireRow.Copy Destination:=dest 'copy la ligne de la cellule
    End If 'fin de la condition
 
Next cel 'prochaine cellule de "ta_plage"
End Sub

Édition :

Évidemment pas frais... pas bon... l'ai d'un c... Robert, l'air d'un c...

[Robert]

Bonjour JeanMikael, Catrice, bonjour le forum,

Non testé mais ça devrait coller...

Sub Comparaison()
 
Application.ScreenUpdating = False
 
Dim x As Long
Dim y As Long
Dim limite As Long
Dim MaValeur, nbcell
Dim plage As Range
Dim Cel As Range
Dim n As Long
Dim cell As Range
Dim dest As Range
 
y = Range("A65536").End(xlUp).Row + 1
For x = 3 To y
    If (Cells(x, "M") <> 0) Then
        If (Cells(x, "U") <> 0) Then Cells(x, "AG") = "Pas D'Erreur" Else Cells(x, "AG") = "Erreur"
    Else
        Cells(x, "AG") = "Pas D'Erreur"
    End If
 
    If (Cells(x, "N") <> 0) Then
        If (Cells(x, "V") <> 0) Then Cells(x, "AH") = "Pas D'Erreur" Else Cells(x, "AH") = "Erreur"
    Else
        Cells(x, "AH") = "Pas D'Erreur"
    End If
 
    If (Cells(x, "O") <> 0) Then
        If (Cells(x, "W") <> 0) Then Cells(x, "AI") = "Pas D'Erreur" Else Cells(x, "AI") = "Erreur"
    Else
        Cells(x, "AI") = "Pas D'Erreur"
    End If
 
    If (Cells(x, "P") <> 0) Then
        If (Cells(x, "X") <> 0) Then Cells(x, "AJ") = "Pas D'Erreur" Else Cells(x, "AJ") = "Erreur"
    Else
        Cells(x, "AJ") = "Pas D'Erreur"
    End If
    If (Cells(x, "Q") <> 0) Then Cells(x, "AK") = "Pas D'Erreur" Else Cells(x, "AK") = "Erreur"
 
    If (Cells(x, "R") <> 0) Then Cells(x, "AL") = "Pas D'Erreur" Else Cells(x, "AL") = "Erreur"
 
    If (Cells(x, "S") <> 0) Then Cells(x, "AM") = "Pas D'Erreur" Else Cells(x, "AM") = "Erreur"
 
    If (Cells(x, "T") <> 0) Then Cells(x, "AN") = "Pas D'Erreur" Else Cells(x, "AN") = "Erreur"
 
Next x
 
'jai pas compris ta boucle de 2 à 2 ?????
 
MaValeur = Range("AG2").Value
Range("AG2").Value = MaValeur + "Erreur Pour ParcN"
Range("AH2").Value = MaValeur + "Erreur Pour ParcN-1"
Range("AI2").Value = MaValeur + "Erreur Pour ParcN-2"
Range("AJ2").Value = MaValeur + "Erreur Pour ParcN-3"
Range("AK2").Value = MaValeur + "Erreur Pour Parc"
Range("AL2").Value = MaValeur + "Erreur Pour Trn-1"
Range("AM2").Value = MaValeur + "Erreur Pour Trn-2"
Range("AN2").Value = MaValeur + "Erreur Pour Trn-3"
 
n = 0
For Each cell In Range("AG:AN")
    Select Case cell.Value
        Case "Erreur", "Erreur Pour ParcN", "Erreur Pour ParcN-1", "Erreur Pour ParcN-2", _
            "Erreur Pour ParcN-3", "Erreur Pour Parc", "Erreur Pour Trn-1", "Erreur Pour Trn-2", _
            "Erreur Pour Trn-3"
            Set dest = Sheets("Feuil2").Range("A65536").End(xlUp).Offset(1, 0)
            cell.EntireRow.Copy Destination:=dest
            n = n + 1
    End Select
Next
 
MsgBox "" & n & " Erreurs Trouvées."
MsgBox "Traitement terminé"
 
Application.ScreenUpdating = True
 
End Sub

[JeanMikael]

Merci beaucoup Robet pour ce code qui correspond à mes attentes
et merci catrice, j'adore ce forum vraiment t'es actif et efficace en attendant
merci à tous et bon week end à bientot