VBA copier coller ligne en boucle avec condition
Bonjour,
Je commence seulement à faire des VBA
j’ai des fichiers avec des centaines de lignes
Je souhaite à partir d’une feuille (feuil1) copier les lignes dans feuil2 seulement si la valeur de la colonne E est supérieur à la colonne G
Mon tableau commence en A20 à AH nombre de ligne
J’ai commencé en faisant ceci :
Dim Nbrligne as integer
Sheets(« Feuil1 »).select
‘Calcul le nombre de ligne
Range(« G1 »).select
ActiveCell.formulaR1C1 = « =COUNT (C[10])+20 »
Nbrligne = Range(« G1 »).value
For i = 21 to Nbrligne
If Range(« E »&i).value > Range(« G »&i).Value Then
C’est la que je n’arrive ps à trouver comment copier les lignes qui rempliront cette condition et les coller dans la feuille 2 en décalage
J’ai essayé
Range(« A »&i& « :AH »&i).select ou .copy
Mais ça ne fonctionne pas
Si vous pouvez m’expliquer mon erreur et comment résoudre ce problème ?
Je vous remercie d’avance
Bonjour,
Pour gagner en clarté, il serait judicieux de joindre un fichier représentatif de ta problématique. Aussi, ton sujet à déjà été abordé en long, en large et en travers, je pense que tu trouveras donc ton bonheur avec une simple recherche dans le forum.
Ensuite, sous VBA :
- Pas besoin de "Select", il suffit de bien mettre la référence des objets sur lesquels on travaille...
- Pas besoin de copier dans une majeure partie des cas : il suffit d'affecter ou reporter les valeurs (ex : Range("A1) = Range("B1"))
- Pourquoi passer par une formule Excel et utiliser le résultat dans le code VBA plutôt que de le faire directement sous VBA ?
- Lorsque l'on copie, il faut ensuite coller, sinon ça marche pas !
Comme je l’ai dit je suis novice c’est pour ça que je demande des conseils
J’ai déjà cherché sur plusieurs forums et regardé plusieurs sujets similaires maisnje n’arrive pas à le mettre en pratique c’est pourquoi je me suis permise de publier mon cas
Pour le copier coller évidemment que j’en fais coller mais l’erreur viens du copier.
Pour gagner en clarté, il serait judicieux de joindre un fichier représentatif de ta problématique.
Tu ne demande pas à ton garagiste de réparer ta voiture sans la lui amener... Nous c'est pareil !
Je ne sais pas ce que tu as dans ton fichier, ni quel code tu as essayé exactement (puisque visiblement tu n'en donne qu'une fraction)...
Pour gagner en clarté, il serait judicieux de joindre un fichier représentatif de ta problématique.
Tu ne demande pas à ton garagiste de réparer ta voiture sans la lui amener... Nous c'est pareil !
Je ne sais pas ce que tu as dans ton fichier, ni quel code tu as essayé exactement (puisque visiblement tu n'en donne qu'une fraction)...
C'est un fichier différent mais avec le même principe copier les lignes si la colonne G est supérieur à la colonne H
La macro se fait mais seulement sur la première ligne qui remplit la condition
Bonjour carap, salut archer !
J'ai fais quelques modifications au niveau de ton code pour accélérer un peu l'exécution. Il n'y a plus utilisation d'une formule Excel ni copier-coller :
Sub Test()
Dim Nbrligne&, L&, L1&, Tab1()
Application.ScreenUpdating = False 'Désactive l'affichage en temps réel
Application.Calculation = xlCalculationManual 'Désactive le recalcul auto des formules Excel à chaque modification
With Sheets(1)
Nbrligne = .Range("G" & .Rows.Count).End(xlUp).Row 'Calcul le nombre de ligne
L1 = 2
For L = 21 To Nbrligne
If .Range("E" & L).Value > .Range("G" & L).Value Then
Tab1 = .Range("A" & L & ":M" & L).Value 'Affecte la ligne dans une variable tableau
Sheets(2).Range("A" & L1 & ":M" & L1).Value = Tab1 'Reporte les valeurs de la variable tableau en feuille 2
L1 = L1 + 1
End If
Next
End With
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
End SubBonjour carap, salut archer !
J'ai fais quelques modifications au niveau de ton code pour accélérer un peu l'exécution. Il n'y a plus utilisation d'une formule Excel ni copier-coller :
Sub Test() Dim Nbrligne&, L&, L1&, Tab1() Application.ScreenUpdating = False 'Désactive l'affichage en temps réel Application.Calculation = xlCalculationManual 'Désactive le recalcul auto des formules Excel à chaque modification With Sheets(1) Nbrligne = .Range("G" & .Rows.Count).End(xlUp).Row 'Calcul le nombre de ligne L1 = 2 For L = 21 To Nbrligne If .Range("E" & L).Value > .Range("G" & L).Value Then Tab1 = .Range("A" & L & ":M" & L).Value 'Affecte la ligne dans une variable tableau Sheets(2).Range("A" & L1 & ":M" & L1).Value = Tab1 'Reporte les valeurs de la variable tableau en feuille 2 L1 = L1 + 1 End If Next End With Application.CutCopyMode = False Application.Calculation = xlCalculationAutomatic End SubTEst macro (3).xlsm
Bonjour,
Merci beaucoup
Juste une dernière question si je veux ajouter d'autres conditions comment je peux faire?
J'ai essayé en faisant le même modèle mais la 2éme condition ne s'effectue pas
Ci-joint le fichier
Remplace :
If .Range("E" & L).Value > .Range("G" & L).Value ThenPar :
If .Range("E" & L).Value > .Range("G" & L).Value And Condition2 ThenOù condition2 est un test ou une valeur logique.
Bonjour
A voir
With Sheets(1)
Nbrligne = .Range("G" & .Rows.Count).End(xlUp).Row
L1 = 2
L2 = 2
For L = 2 To Nbrligne
If .Range("G" & L).Value > .Range("H" & L).Value Then
Tab1 = .Range("A" & L & ":M" & L).Value
Sheets(2).Range("A" & L1 & ":M" & L1).Value = Tab1
L1 = L1 + 1
End If
If Range("L" & L).Value > .Range("M" & L).Value Then
Tab2 = .Range("A" & L & ":M" & L).Value
Sheets(3).Range("A" & L2 & ":M" & L2).Value = Tab2
L2 = L2 + 1
End If
Next
End WithA+
Maurice