Copie d'une ligne vers une autre feuille selon condition

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
J

JeanMikael

XLDnaute Junior
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
 
Trier par date Trier par votes
Re : Copie d'une ligne vers une autre feuille selon condition

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
 
Vote positif 0 Vote négatif
Re : Copie d'une ligne vers une autre feuille selon condition

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
 
Vote positif 0 Vote négatif
Re : Copie d'une ligne vers une autre feuille selon condition

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 :
Code: 
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...
 
Vote positif 0 Vote négatif
Re : Copie d'une ligne vers une autre feuille selon condition

Bonjour JeanMikael, Catrice, bonjour le forum,

Non testé mais ça devrait coller...

Code: 
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
 
Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

flc13090
  • Résolu(e)
XL 2019 Problème de copie de plages non contiguës vers une autre feuille en VBA
Réponses
9
Affichages
159
flc13090
flc13090
A
  • Résolu(e)
Microsoft 365 programme VBA pour "importer" les valeurs de certaines cellules d'une autre feuille appartenant à une ligne que j'identifie par un n°
2
Réponses
27
Affichages
869
arnomorize
A
M
  • Question Question
XL 2019 Transposer des données d'une feuille vers une autre sous forme de synthèse
Réponses
8
Affichages
501
mromain
mromain
A
  • Question Question
XL 2019 Ajouter ou supprimer une ligne selon un mot trouvé dans une autre feuille
Réponses
1
Affichages
432
Oneida
Oneida
L
  • Question Question
XL 2021 Renvoi d'une valeur texte dans une colonne d une autre feuille
Réponses
6
Affichages
240
laurent34750
L
S
  • Résolu(e)
XL 2016 copier des données d'une feuille à une autre selon critères et protection de la feuille 1
Réponses
6
Affichages
615
steph_29120
S
W
  • Résolu(e)
XL 2016 Gestion de liste transposée dans une autre feuille avec décalage d'une colonne et exclusion de certains éléments
Réponses
9
Affichages
499
Webperegrino
W
chris6999
  • Question Question
Microsoft 365 Copier une plage vers une autre feuille depuis un USF
Réponses
4
Affichages
278
chris6999
chris6999
N
  • Question Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
668
Nel'
N
G
  • Résolu(e)
Microsoft 365 Copie d'une ligne vers une autre feuille VBA
Réponses
4
Affichages
784
Dranreb
Dranreb
U
  • Question Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
472
Phil69970
Phil69970
S
  • Question Question
Microsoft 365 VBA pour copier une une des données d'une ligne à une autre
Réponses
3
Affichages
767
salma_hayek
S
T
  • Résolu(e)
Microsoft 365 Chercher si dans une plage de cellule la valeur d'une autre cellule est présente
Réponses
4
Affichages
386
TomJoad
T
H
  • Résolu(e)
Microsoft 365 Archivage automatique sous condition (Macro)
Réponses
2
Affichages
589
HugoLaChips
H
B
  • Question Question
Microsoft 365 Bon de commande avec recapitulatif des lignes saisies sur une autre feuille
Réponses
1
Affichages
486
djidji59430
djidji59430
P
  • Question Question
XL 2019 Modification d'une ligne d'une autre feuille lors d'un echange d'effet dans un userform
Réponses
11
Affichages
940
TooFatBoy
TooFatBoy
N
  • Résolu(e)
XL 2021 copier ligne vers une feuille existante sous condition et supprimer ligne de la feuille d'origine
Réponses
9
Affichages
749
NicolasKH
N
M
  • Question Question
Microsoft 365 Problème de copie de ligne d’une feuille à une autre
Réponses
1
Affichages
269
moanin
M
J
  • Question Question
Autres Supprimer une ligne dans une feuille à partir d'une valeur rentrée dasn une cellule d'une autre feuille
2
Réponses
25
Affichages
2 K
jmc78
J
Q
  • Question Question
XL 2019 Si une colonne contient le mot fermé, forcé, copier la ligne vers une autre feuille
Réponses
2
Affichages
499
job75
job75
Retour