Résolu Transfert de lignes d'une feuille vers une autre feuille suite à un test (vba)

[JDEBRAY]

Bonjour à tous,

Apres plusieurs lectures des sujets qui sont sur ce forum (tres bien documenté ceci étant dit), j'essaie de créer un code vba qui me permet de :
1- Sur l'onglet 1: scanner toutes les lignes d'une colonne H pour voir si le mot OK apparait
2- Sur l'onglet 1: scanner toutes les lignes d'une colonne A pour voir le mot inscrit (prod 1, prod 2). ces données étant liée à un menu déroulant donc figées.
3- Transférer les données de la ligne concernée si les 2 tests précédents sont validés vers l'onglet correspondant au nom de la case A (il y a autant d'onglet dans mon classeur que de mot inscrit possible dans la case A)
4 -revenir sur ma page principale et supprimer les lignes qui ont été copiées.
Pour le moment, je n'en suis qu'au début de l'étape 1 & 3.
Ci dessous mon code.

Sub Essai()
    
J = 6
For i = 2 To 65536

If Worksheets("Suivi des actions").Range("H" & i).Value = "OK" Then
Worksheets("Archives L1").Range("A" & J & ":H" & J).Value = Worksheets("Suivi des actions").Range("A" & i & ":H" & i).Value
J = J + 1

End If

Next

End Sub

Mais maintenant, je bloque...
Pouvez vous m'aider svp?
Merci par avance

 

[zeb]

Salut Debray,
J'ai plusieurs casquette ici

IMPERATIF
Le modérateur te demande de bien vouloir présenter ton code en utilisant la balise [code] plutôt que [quote].
Utilise les boutons "Edition Rapide" ou "Modifier" en bas à droite de ton message.
Merci.

---------------------

CONSEIL
Le programmeur te demande d'indenter ton code et d'abandonner le principe de reprendre le nom de variable derrière le Next.
(On faisait comme ça en 1985, c'est vrai.)

---------------------

FACULTATIF
Le professeur te propose, si tu cherches à mieux programmer et à progresser, de nous servir de ce sujet intéressant pour te montrer des tas de trucs utiles. En plus tu auras bientôt une macro efficace pour résoudre ton problème et un modèle à suivre pour tes prochaines macros.

 

[JDEBRAY]

Zeb,

merci d'ores et deja de ta réponse.
Voila les modifications sont faites.
Que veut dire le mot indenter??
J'ai essayer de lire certains posts et je n'ai donc pas utiliser dans ma macro le copier coller, mais maintenant, je bloque...
Pouvez vous m'aider professeur?
Merci encore

 

[zeb]

Indentation est une incantation religieuse que les gourous de toutes les sectes informatiques imposent à leurs ouailles, de gré ou de force.
Un novice qui n'indenterait pas après une première injonction serait voué aux gémonies. Autant te dire que t'as intérêt à vite le faire.

Vous devez être connecté pour voir les liens.

-------------------------

J'ai ajouté =VB à la balise pour faire encore plus joli. Fais-le de toi-même la prochaine fois.

-------------------------

Première chose, on va travailler avec des lignes, des colonnes, des cellules, plutôt qu'avec des coordonnées.

Ensuite, 65536 lignes, c'est beaucoup. Mais avec les dernières versions d'Excel, c'est encore plus !!!!
Alors on va tâcher de réduire la zone au minimum.

Dans un premier temps, on ne va traiter que le cas d'une seule "prod". On verra ça après.

On a une source de données et une cible où mettre celles qui nous intéressent.
En angliche (pratique parce que concis et sans accent), ça fait source et target. (deux mots de même nombre de lettres, c'est plus joli)

On a des feuilles, des zones de cellues, des lignes. Définissons-les.

Dim SheetSource As Worksheet ' la feuille source
Dim SheetTarget As Worksheet ' la feuille cible
Dim LineSource  As Range     ' la ligne source courante
Dim CellTarget  As Range     ' la ligne cible courante (retenir la première cellule suffit en fait)
Dim ZoneSource  As Range     ' la plage de cellules à considérer

Set SheetSource = Worksheets("Suivi des actions")
Set SheetTarget = Worksheets("Archives L1")
Set CellTarget  = SheetTarget.Cells(6, "A")
Set ZoneSource  = SheetSource.Range("A2:H65536") ' // on verra plus tard comment réduire ça à notre zone effective.

Maintenant, on va parcourir ligne à ligne notre zone :

For Each LineSource In ZoneSource.Rows
    ...
Next

Il reste à remplir la boucle !
Il faut y vérifier la condition Ok :

If LineSource.Cells(8).Value = "OK" Then
    ' Il faut copier la ligne vers la cible
    LineSource.Copy Destination:=CellTarget
    ' Et on déplace la cible pour la prochaine fois !
    Set CellTarget = CellTarget.Offset(1)
End If

Intègre bien tout ça.
On continue dès que tu me dis que tu as tout compris.

 

[JDEBRAY]

Bonjour ZEB,

Merci de cette première réponse.
Sur le début du code, j'ai ajouté OPTION ECPLICIT comme tu le suggères dans différents posts, je ne sais pas si j'ai bien fait mais j'essaie....
si je comprends bien le code, on définit d'abord les variables (dim...), puis on affecte les noms des feuilles avec SET...
et ensuite débute le raitement avec la boucle for et le test if.
Si c'est bien cela, j'ai compris le code pour le moment en tout cas...
Ce que je ne comprends pas c'est cet "=VB à la balise ?
Je ne comprends pas non plus la ligne:

Set CellTarget = CellTarget.Offset(1)

Option Explicit

Sub archivage()

Dim SheetSource As Worksheet ' la feuille source
Dim SheetTarget As Worksheet ' la feuille cible
Dim LineSource  As Range     ' la ligne source courante
Dim CellTarget  As Range     ' la ligne cible courante (retenir la première cellule suffit en fait)
Dim ZoneSource  As Range     ' la plage de cellules à considérer
Set SheetSource = Worksheets("Suivi des actions")
Set SheetTarget = Worksheets("Archives L1")
Set CellTarget = SheetTarget.Cells(6, "A")
Set ZoneSource = SheetSource.Range("A2:H65536")  ' // on verra plus tard comment réduire ça à notre zone effective
For Each LineSource In ZoneSource.Rows

If LineSource.Cells(8).Value = "OK" Then
    ' Il faut copier la ligne vers la cible
    LineSource.Copy Destination:=CellTarget
    ' Et on déplace la cible pour la prochaine fois !
    Set CellTarget = CellTarget.Offset(1)
End If

Next


End Sub

Sinon, OK, je te suis avec plaisir!!

 

[zeb]

Avec =VB

[ c o d e = V B ]

Dim x As Integer
For Each Truc In Machin
    ...
Next

[ / c o d e ]

Sans =VB
[ c o d e ]

Dim x As Integer
For Each Truc In Machin
    ...
Next

[ / c o d e ]

C'est juste une histoire de présentation

--------------------------------

Tu lis mes posts et tu utilises l'Option Explicit ?
Tu es mon novice préféré !

 

[zeb]

Set CellTarget = CellTarget.Offset(1)

Pour bien comprendre :

• 
  ■ Ouvrir un dico anglais et lire la définition de Offset (anglophone, s'abstenir.)
  ■ Ouvrir l'aide d'Excel/VBA à la page Offset(). Tout lire, tout comprendre (ne pas hésiter à reposer ici des questions)
  ■ Faire des essais. Exemple :

MsgBox "La cellule cible est : " & CellTarget.Address
Set CellTarget = CellTarget.Offset(1)
MsgBox "La cellule cible est : " & CellTarget.Address

• 
  ■ Réfléchir...
  ■ Reposer la question à la lumière de ces quelques éléments

Il est chiant ce prof'. Il donne des devoirs à la maison
[:glublutz:25]

 

[JDEBRAY]

OK, je viens de trouver l'aide et le moyen de la faire fonctionner.
Donc cette fonction te permet de décaler d'une ligne une fois que nous avons copier la ligne complète dans celltarget.
Une petite question, pourquoi mettre := entre les 2 termes de la ligne 20.
Sinon, la mpacro commence à fonctionner.
Je cherche maintenant le moyen de filter sur la valeur de la colonne B.
Ces valeurs sont définies par un menu déroulant et donc je dois scanner les lignes comportant un OK et les envoyer vers l'onglet correspondant.
Ensuite, je dois supprimer les lignes ayant été copiées.
C'est plus dur pour moi.

 

[JDEBRAY]

ZEB!!

j'ai réussi, en utilisant la fonction AND via l'aide à transférer les lignes de mes 2 tests vers la première feuille!!!trop cool

Maintenant, il faut que fasse de meme pour les autres types de données et il faut que je supprime les lignes copiées avec le test OK

 

[JDEBRAY]

Bon et bien apres de multiples opérations, voici le code:

Option Explicit

Sub archivage()

Dim SheetSource As Worksheet ' la feuille source
Dim SheetTarget1, sheetTarget2, sheettarget3, sheettarget4, sheettarget5  As Worksheet ' la feuille cible
Dim LineSource  As Range     ' la ligne source courante
Dim CellTarget1, celltarget2, celltarget3, celltarget4, celltarget5 As Range  ' la ligne cible courante (retenir la première cellule suffit en fait)
Dim ZoneSource  As Range     ' la plage de cellules à considérer
Set SheetSource = Worksheets("Suivi des actions")
Set SheetTarget1 = Worksheets("Archives L1")
Set sheetTarget2 = Worksheets("Archives L2")
Set sheettarget3 = Worksheets("Archives L3")
Set sheettarget4 = Worksheets("Archives L4")
Set sheettarget5 = Worksheets("Archives L5")
Set CellTarget1 = SheetTarget1.Cells(2, "A")
Set celltarget2 = sheetTarget2.Cells(2, "A")
Set celltarget3 = sheettarget3.Cells(2, "A")
Set celltarget4 = sheettarget4.Cells(2, "A")
Set celltarget5 = sheettarget5.Cells(2, "A")
Set ZoneSource = SheetSource.Range("A2:H65536")  ' // on verra plus tard comment réduire ça à notre zone effective

For Each LineSource In ZoneSource.Rows

If LineSource.Cells(8).Value = "OK" And LineSource.Cells(2).Value = "Ligne 1" Then
    ' Il faut copier la ligne vers la cible
    LineSource.Copy Destination:=CellTarget1
    ' Et on déplace la cible pour la prochaine fois !
    Set CellTarget1 = CellTarget1.Offset(1)
    
End If

If LineSource.Cells(8).Value = "OK" And LineSource.Cells(2).Value = "Ligne 2" Then
    ' Il faut copier la ligne vers la cible
    LineSource.Copy Destination:=celltarget2
    ' Et on déplace la cible pour la prochaine fois !
    Set celltarget2 = celltarget2.Offset(1)

End If

If LineSource.Cells(8).Value = "OK" And LineSource.Cells(2).Value = "Ligne 3" Then
    ' Il faut copier la ligne vers la cible
    LineSource.Copy Destination:=celltarget3
    ' Et on déplace la cible pour la prochaine fois !
    Set celltarget3 = celltarget3.Offset(1)

End If

If LineSource.Cells(8).Value = "OK" And LineSource.Cells(2).Value = "Ligne 4" Then
    ' Il faut copier la ligne vers la cible
    LineSource.Copy Destination:=celltarget4
    ' Et on déplace la cible pour la prochaine fois !
    Set celltarget4 = celltarget4.Offset(1)

End If

If LineSource.Cells(8).Value = "OK" And LineSource.Cells(2).Value = "Ligne 5" Then
    ' Il faut copier la ligne vers la cible
    LineSource.Copy Destination:=celltarget5
    ' Et on déplace la cible pour la prochaine fois !
    Set celltarget5 = celltarget5.Offset(1)

End If

Next


End Sub

La macro est un peu longue mais elle fonctionne bien.
maintenant, peux tu m'expliquer comment supprimer les lignes "copiées"??
Merci par avance parce que la je ne sais pas du tout

 

[drul]

Un élément de réponse:

Cells(1, 1).EntireRow.Delete

Consulte l'aide la dessus et tu devrais t'en tirer.

P.S. bravo à toi (et à Zeb) pour les progrès accomplis.

 

[zeb]

Attention à la suppression.
J'ai écrit un laïus sur le sujet ici :

Vous devez être connecté pour voir les liens.

A appliquer (quitte à demander un peu d'aide )

-----------------

C'est mal indenté !
:fou: :fou: :fou: :fou:

Les lignes 5 à 65 devraient être décalées par rapport à la ligne 3.
Les lignes 25 à 63 devraient être décalées par rapport à la ligne 23.

Je pinaille si je veux

-----------------

La notation := ?
C'est la syntaxe pour l'affectation des arguments nommés.

Deux syntaxes existent :

La traditionnelle, où il faut passer les arguments dans l'ordre de la définition de la fonction, quitte à laisser un vide entre deux virgules si on ne souhaite pas préciser une valeur.

L'autre, où on peut donner les arguments que l'on veut, dans l'ordre que l'on veut.

Exemple avec MsgBox(Prompt, Buttons, Title, HelpFile, Context).

MsgBox "Salut JD", , "Salutation"
MsgBox Title:="Salutation", Prompt:="Salut JD"

La méthode Copy([Destination]) n'accepte qu'un seul argument facultatif. Donc le préciser est complètement inutile - pour VB.
Mais pour bien fixer les idées, je l'ajoute dans les codes que je vous propose. (Euh, du coup, quand je le fais pour moi, je le fais aussi )

-----------------

Dim SheetTarget1, sheetTarget2, sheettarget3, sheettarget4, sheettarget5 As Worksheet
Dim CellTarget1, celltarget2, celltarget3, celltarget4, celltarget5 As Range

Ca, ça ne marche pas.

SheetTarget1, sheetTarget2, sheettarget3, sheettarget4, ne seront pas de type Worksheet, CellTarget1, celltarget2, celltarget3, celltarget4 ne seront pas de type Range.
Ils seront de type Variant.

Devoir à la maison : chercher pourquoi.

--------------

Ton code fait 5 fois la même chose, c'est mal !

Dans un premier temps, on ne va traiter que le cas d'une seule "prod". On verra ça après.

Il est donc temps de voir ça !

 

[zeb]

Et voilà.

Option Explicit
     
Sub archivage()
    ' Source
    Dim LineSource As Range

    ' Cibles
    Dim CellTarget(1 To 5)  As Range
    
    Dim i As Integer
    For i = 1 To 5
        Set CellTarget(i) = Worksheets("Archives L" & i).Cells(2, "A")
    Next

    Dim s As String
    For Each LineSource In Worksheets("Suivi des actions").Range("A2:H65536").Rows
        If LineSource.Cells(8).Value = "OK" And _
           LineSource.Cells(2).Value Like "Ligne *" Then
            s = Mid(LineSource.Cells(2).Value, 7)
            If IsNumeric(s) Then
                i = CInt(s)
                If 1 <= i And i <= 5 Then
                    LineSource.Copy CellTarget(i)
                    Set CellTarget(i) = CellTarget(i).Offset(1)
                End If
            End If
        End If
    Next
End Sub

Comme tu avais bien compris l'étape précédente, je me permets de te donner directement la solution car je suis sûr que tu ne manqueras pas de bien l'étudier pour en tirer la quintessence.

J'ai fortement factorisé le code. Comprends-le bien.
Si tu as des questions, n'hésite pas.

------------------

La prochaine étape consistera à ne pas traiter 65535 lignes !!!!

(On verra plus tard la suppression)

 

[JDEBRAY]

Bonjour ZEB,

Tout d'abord, merci pour ta réponse.
En effet, le code est plus court et donc pour moi plus difficile à interpréter.
Néanmoins, je l'ai testé et j'ai un bug à la ligne 12: "Impossible d'affecter un tableau".
Le code, je pense le comprendre mais je serai bien incapable de le construire.
Le principe pour moi est le même que précdemmenet:
1- On déclare des variables
2- on vient attribuer une "valeur" à cette variable. Pour les pages, cela varie avec "i".
3- La ligne 19, je ne la comprends pas. Surtout le MID.
4- Ensuite, tu réalises un test pour voir si S est un nombre (et la je pense que je n'ai pas tout dit (Le couac est que j'ai aussi des noms d'ateliers. Exemple: j'ai 5 lignes comme tu l'as constaté mais j'ai aussi des noms comme soufflage, maintenance, et autres d'ailleurs.....)
5- La ligne 21, je ne comprends pas non plus.
Pour le reste c'est OK, je suis.
Mais je te le redis, c'est extrement sympa de ta part de m'aider!!!
A suivre donc, PROF

 

[zeb]

Pour la ligne 12, regarde mieux le code proposé
( [atch] )

------------

Pour Mid(), je suis un peu déçu.
As-tu regardé l'aide ?

Étudie ça :

Dim nom As String
nom = "JDEBRAY"
MsgBox Mid(nom, 1, 1) & "2" & Mid(nom, 4)

------------

Pour CInt(), je suis TRES déçu.
RTFM! [:zeb:4]

------------

Pour le reste c'est OK, je suis.

Je suis moins déçu du coup

------------

Bon, alors cette histoire de noms comme indice, c'est effectivement un gros couac.
VB n'est pas fichu de disposer d'un système de hachage et/ou de clef non scalaire pour ces tableaux.


C'est un peu pénible........

 

[JDEBRAY]

Salut ZEB,

maintenant je pense avoir compris le code.
Comme je l'ai écrit, certains onglest ne sont pas numériques mais pour le moment, ce n'est pas grave s'ils ne sont pas pris en compte.
Pourrais tu m'aider sur la partie suppression des lignes car je dois présenter cela à mon responsable...
Merci encore pour ton aide.
Cdlt,

jerome

 

[zeb]

Pourrais tu m'aider sur la partie suppression des lignes

Oui, volontiers...

car je dois présenter cela à mon responsable...

M'en fous comme de l'an 70 (*)

Bon.
As-tu lu l'article sur la suppression que je te proposai ?

Vous devez être connecté pour voir les liens.

Donc comme tu le vois, ce n'est pas aussi trivial qu'on pourrait le croire.

Il y a plusieurs solutions à ce problème. Remonter du bas vers le haut comme déjà discuté. Mais on peut aussi accumuler au fur et à mesure dans une variable les lignes à supprimer, puis toutes les supprimer.

Par exemple, en parcourant les 10 premières lignes, je veux supprimer les lignes 3 et 4.

Ces codes ne fonctionnent pas :

Dim i As Long
For i = 1 To 10
    If i = 3 Or i = 4 Then Rows(i).delete
Next

Dim line As Range
For Each line In Rows("1:10")
    If line.row = 3 Or line.row = 4 Then line.delete
Next

Celui-ci, si :

Dim i As Long
For i = 10 To 1 Step -1
    If i = 3 Or i = 4 Then Rows(i).delete
Next

Celui-là, aussi :

Dim line As Range
Dim to_delete As Range
For Each line In Rows("1:10")
    If line.Row = 3 Or line.Row = 4 Then 
        If to_delete Is Nothing Then Set to_delete = line Else Set to_delete = Union(to_delete, line)
    End If
Next
to_delete.delete

Tu regardes tout ça et tu me dis si l'implémentation te pose problème


_____
(*) epoch.

 

[JDEBRAY]

Salut ZEB,

MERCI et encore MERCI!!
j'utilise le code N°2 et cela fonctionne tres tres bien.
Je vais voter pour cette réponse!!
et je vais pourvoir aller voir monn patron mais ca je crois que tu t'en moques.....


J'essaie maintenant de forcer, avec une macro la valeur de la plage F1:F2 et de mettre: Ligne 3 mais mon code ne fonctionne pas...
J'ai lu certains topics mais la encore, j'aurai beoins de ton aide.

Option Explicit

Sub essai()

Dim feuille As Worksheets

Dim plage As Range

For Each plage In Workbooks("Suivi quotidien Ligne3.xls").Worksheets
    plage = Range("F1:F2")

    Range("F1:F2").value= "Ligne 3"

    
Next feuille

End Sub

 

[drul]

ce serait déjà mieux de faire

for each feuille in

non?

edit:
Ensuite tu vires ce plage totalement inutile et tu rajoute "feuille" devant range("F:F2")
et finalement tu vire Feuille après le next (comme notre ami Zeb se tue à le dire, on est plus en 1985)

ce qui donne:

Option Explicit
Sub essai()
Dim feuille As Worksheet
 
For Each feuille In ActiveWorkbook.Worksheets
    feuille.Range("F1:F2") = "Ligne 3"
Next
End Sub

 

[zeb]

+1 avec Drulvador !

[:zeb:6]
Jdeb' c'est un nouveau problème ?
Fais un nouveau sujet. Celui est déjà résolu !