Rechercher
Se connecter avec
S'enregistrer | Connectez-vous

Extraire des données de plusieurs feuilles avec deux conditions vers une autre feuille

Dernière réponse : dans Programmation
Partagez

Bonjour,

J'ai enregistrée une macro afin de pouvoir extraire des données de plusieurs feuilles vers une seule si une données d'une colonne correspond à deux conditions différentes.
Bon, je ne sai pas si je m'explique bien mais voilà :
j'ai une base de données de documents classés par feuilles : j'ai donc une feuille "Ancien systeme", une feuille "Procedure", une feuille "Instruction", une feuille "Formulaire" et une feuille "Liste".
Chacune des feuilles contiennent les même informations au niveau des colonnes : "A=Référence", "B=Ancienne Référence", "C=TITRE", "E=Rédacteur", "F=Service Emetteur".....plein d'autres colonnes mais qui ne m'intéresse pas dans l'extraction....et enfin, "S=Date de fin de validité" et "T= Obsolete", sauf pour la feuille "Ancien systeme" dont la colonne A est vide!
Je souhaite donc extraite les données des colonnes que j'ai nommés ci-dessus vers une autre feuille que j'appellerais "liste des obso" en donnant comme conditions que "OBSO" ou "FUTUR OBSO" soit dans la colonne "T=Obsolete" et que chaque extraction arrive à la suite de l'autre.
C'est à dire que l'extraction qui sera faite de la feuille ancien systeme soit en premier, que l'extraction de la feuille Procedure arrive à la première ligne vide et ainsi de suite.

  1. Sub Macro1()
    

  2. '
    

  3. ' Macro1 Macro
    

  4. '
    

  5.  
  6. '
    

  7.     Rows("5:500").Select
    

  8.     Application.CutCopyMode = False
    

  9.     Selection.Delete Shift:=xlUp
    

  10.     Range("A5").Select
    

  11.     Sheets("Ancien Systeme").Select
    

  12.     ActiveSheet.Range("$B$1:$W$10").AutoFilter Field:=18, Criteria1:="<>"
    

  13.     ActiveWindow.SmallScroll Down:=-18
    

  14.     ActiveWindow.SmallScroll ToRight:=-3
    

  15.     Range("R3:S10").Select
    

  16.     ActiveWindow.SmallScroll ToRight:=-9
    

  17.     Range("R3:S10,B3:E10").Select
    

  18.     Range("E3").Activate
    

  19.     Selection.Copy
    

  20.     Sheets("Liste des Obso").Select
    

  21.     Range("B5").Select
    

  22.     ActiveSheet.Paste
    

  23.     Range("A12:G12").Select
    

  24.     Application.CutCopyMode = False
    

  25.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    

  26.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    

  27.     With Selection.Borders(xlEdgeLeft)
    

  28.         .LineStyle = xlContinuous
    

  29.         .ColorIndex = 0
    

  30.         .TintAndShade = 0
    

  31.         .Weight = xlThin
    

  32.     End With
    

  33.     With Selection.Borders(xlEdgeTop)
    

  34.         .LineStyle = xlContinuous
    

  35.         .ColorIndex = 0
    

  36.         .TintAndShade = 0
    

  37.         .Weight = xlThin
    

  38.     End With
    

  39.     With Selection.Borders(xlEdgeBottom)
    

  40.         .LineStyle = xlContinuous
    

  41.         .ColorIndex = 0
    

  42.         .TintAndShade = 0
    

  43.         .Weight = xlThin
    

  44.     End With
    

  45.     With Selection.Borders(xlEdgeRight)
    

  46.         .LineStyle = xlContinuous
    

  47.         .ColorIndex = 0
    

  48.         .TintAndShade = 0
    

  49.         .Weight = xlThin
    

  50.     End With
    

  51.     Selection.Borders(xlInsideVertical).LineStyle = xlNone
    

  52.     Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    

  53.     With Selection.Interior
    

  54.         .Pattern = xlSolid
    

  55.         .PatternColorIndex = xlAutomatic
    

  56.         .ThemeColor = xlThemeColorAccent5
    

  57.         .TintAndShade = 0.799981688894314
    

  58.         .PatternTintAndShade = 0
    

  59.     End With
    

  60.     Sheets("Ancien Systeme").Select
    

  61.     ActiveWindow.ScrollColumn = 5
    

  62.     ActiveWindow.ScrollColumn = 6
    

  63.     ActiveWindow.ScrollColumn = 7
    

  64.     ActiveWindow.ScrollColumn = 11
    

  65.     ActiveWindow.ScrollColumn = 12
    

  66.     ActiveWindow.ScrollColumn = 13
    

  67.     ActiveWindow.ScrollColumn = 14
    

  68.     ActiveWindow.ScrollColumn = 15
    

  69.     ActiveWindow.ScrollColumn = 16
    

  70.     ActiveWindow.ScrollColumn = 17
    

  71.     ActiveWindow.ScrollColumn = 18
    

  72.     ActiveWindow.ScrollColumn = 19
    

  73.     ActiveSheet.Range("$B$1:$W$10").AutoFilter Field:=18
    

  74.     Sheets("Procedure").Select
    

  75.     ActiveSheet.Range("$A$1:$X$293").AutoFilter Field:=20, Criteria1:="<>"
    

  76.     ActiveWindow.SmallScroll Down:=-24
    

  77.     Range("S6:T267").Select
    

  78.     ActiveWindow.ScrollColumn = 16
    

  79.     ActiveWindow.ScrollColumn = 15
    

  80.     ActiveWindow.ScrollColumn = 14
    

  81.     ActiveWindow.ScrollColumn = 13
    

  82.     ActiveWindow.ScrollColumn = 12
    

  83.     ActiveWindow.ScrollColumn = 11
    

  84.     ActiveWindow.ScrollColumn = 10
    

  85.     ActiveWindow.ScrollColumn = 9
    

  86.     ActiveWindow.ScrollColumn = 8
    

  87.     ActiveWindow.ScrollColumn = 7
    

  88.     ActiveWindow.ScrollColumn = 6
    

  89.     ActiveWindow.ScrollColumn = 5
    

  90.     ActiveWindow.ScrollColumn = 3
    

  91.     ActiveWindow.ScrollColumn = 2
    

  92.     ActiveWindow.ScrollRow = 175
    

  93.     ActiveWindow.ScrollRow = 159
    

  94.     ActiveWindow.ScrollRow = 152
    

  95.     ActiveWindow.ScrollRow = 149
    

  96.     ActiveWindow.ScrollRow = 132
    

  97.     ActiveWindow.ScrollRow = 119
    

  98.     ActiveWindow.ScrollRow = 113
    

  99.     ActiveWindow.ScrollRow = 111
    

  100.     ActiveWindow.ScrollRow = 108
    

  101.     ActiveWindow.ScrollRow = 101
    

  102.     ActiveWindow.ScrollRow = 98
    

  103.     ActiveWindow.ScrollRow = 93
    

  104.     ActiveWindow.ScrollRow = 89
    

  105.     ActiveWindow.ScrollRow = 88
    

  106.     ActiveWindow.ScrollRow = 78
    

  107.     ActiveWindow.ScrollRow = 68
    

  108.     ActiveWindow.ScrollRow = 67
    

  109.     ActiveWindow.ScrollRow = 61
    

  110.     ActiveWindow.ScrollRow = 56
    

  111.     ActiveWindow.ScrollRow = 54
    

  112.     ActiveWindow.ScrollRow = 49
    

  113.     ActiveWindow.ScrollRow = 47
    

  114.     ActiveWindow.ScrollRow = 43
    

  115.     ActiveWindow.ScrollRow = 37
    

  116.     ActiveWindow.ScrollRow = 28
    

  117.     ActiveWindow.ScrollRow = 25
    

  118.     ActiveWindow.ScrollRow = 17
    

  119.     ActiveWindow.ScrollRow = 6
    

  120.     ActiveWindow.SmallScroll Down:=-9
    

  121.     Range("A6:F267").Select
    

  122.     Range("F6").Activate
    

  123.     ActiveWindow.ScrollColumn = 3
    

  124.     ActiveWindow.ScrollColumn = 4
    

  125.     ActiveWindow.ScrollColumn = 6
    

  126.     ActiveWindow.ScrollColumn = 7
    

  127.     ActiveWindow.ScrollColumn = 8
    

  128.     ActiveWindow.ScrollColumn = 9
    

  129.     ActiveWindow.ScrollColumn = 10
    

  130.     ActiveWindow.ScrollColumn = 11
    

  131.     ActiveWindow.ScrollColumn = 12
    

  132.     ActiveWindow.ScrollRow = 175
    

  133.     ActiveWindow.ScrollRow = 158
    

  134.     ActiveWindow.ScrollRow = 151
    

  135.     ActiveWindow.ScrollRow = 150
    

  136.     ActiveWindow.ScrollRow = 132
    

  137.     ActiveWindow.ScrollRow = 122
    

  138.     ActiveWindow.ScrollRow = 113
    

  139.     ActiveWindow.ScrollRow = 111
    

  140.     ActiveWindow.ScrollRow = 108
    

  141.     ActiveWindow.ScrollRow = 102
    

  142.     ActiveWindow.ScrollRow = 100
    

  143.     ActiveWindow.ScrollRow = 93
    

  144.     ActiveWindow.ScrollRow = 88
    

  145.     ActiveWindow.ScrollRow = 77
    

  146.     ActiveWindow.ScrollRow = 69
    

  147.     ActiveWindow.ScrollRow = 67
    

  148.     ActiveWindow.ScrollRow = 62
    

  149.     ActiveWindow.ScrollRow = 61
    

  150.     ActiveWindow.ScrollRow = 56
    

  151.     ActiveWindow.ScrollRow = 54
    

  152.     ActiveWindow.ScrollRow = 49
    

  153.     ActiveWindow.ScrollRow = 46
    

  154.     ActiveWindow.ScrollRow = 43
    

  155.     ActiveWindow.ScrollRow = 38
    

  156.     ActiveWindow.ScrollRow = 28
    

  157.     ActiveWindow.ScrollRow = 25
    

  158.     ActiveWindow.ScrollRow = 17
    

  159.     ActiveWindow.ScrollRow = 5
    

  160.     Range("A6:F267,S6:T267").Select
    

  161.     Range("S6").Activate
    

  162.     Selection.Copy
    

  163.     Sheets("Liste des Obso").Select
    

  164.     Cells(Range("K1"), 1).Select
    

  165.     ActiveSheet.Paste
    

  166.     ActiveWindow.SmallScroll Down:=48
    

  167.     Range("A63:G63").Select
    

  168.     Application.CutCopyMode = False
    

  169.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    

  170.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    

  171.     With Selection.Borders(xlEdgeLeft)
    

  172.         .LineStyle = xlContinuous
    

  173.         .ColorIndex = 0
    

  174.         .TintAndShade = 0
    

  175.         .Weight = xlThin
    

  176.     End With
    

  177.     With Selection.Borders(xlEdgeTop)
    

  178.         .LineStyle = xlContinuous
    

  179.         .ColorIndex = 0
    

  180.         .TintAndShade = 0
    

  181.         .Weight = xlThin
    

  182.     End With
    

  183.     With Selection.Borders(xlEdgeBottom)
    

  184.         .LineStyle = xlContinuous
    

  185.         .ColorIndex = 0
    

  186.         .TintAndShade = 0
    

  187.         .Weight = xlThin
    

  188.     End With
    

  189.     With Selection.Borders(xlEdgeRight)
    

  190.         .LineStyle = xlContinuous
    

  191.         .ColorIndex = 0
    

  192.         .TintAndShade = 0
    

  193.         .Weight = xlThin
    

  194.     End With
    

  195.     Selection.Borders(xlInsideVertical).LineStyle = xlNone
    

  196.     Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    

  197.     With Selection.Interior
    

  198.         .Pattern = xlSolid
    

  199.         .PatternColorIndex = xlAutomatic
    

  200.         .ThemeColor = xlThemeColorAccent5
    

  201.         .TintAndShade = 0.799981688894314
    

  202.         .PatternTintAndShade = 0
    

  203.     End With
    

  204.     Sheets("Procedure").Select
    

  205.     ActiveSheet.Range("$A$1:$X$293").AutoFilter Field:=20
    

  206.     Sheets("Instruction").Select
    

  207.     ActiveWindow.ScrollColumn = 3
    

  208.     ActiveWindow.ScrollColumn = 4
    

  209.     ActiveWindow.ScrollColumn = 6
    

  210.     ActiveWindow.ScrollColumn = 7
    

  211.     ActiveWindow.ScrollColumn = 8
    

  212.     ActiveWindow.ScrollColumn = 9
    

  213.     ActiveWindow.ScrollColumn = 10
    

  214.     ActiveWindow.ScrollColumn = 11
    

  215.     ActiveWindow.ScrollColumn = 12
    

  216.     ActiveWindow.ScrollColumn = 13
    

  217.     Columns("S:U").Select
    

  218.     Selection.EntireColumn.Hidden = False
    

  219.     ActiveSheet.Range("$A$1:$Y$224").AutoFilter Field:=20, Criteria1:="<>"
    

  220.     ActiveWindow.SmallScroll Down:=-24
    

  221.     Range("S7:T168").Select
    

  222.     ActiveWindow.ScrollColumn = 12
    

  223.     ActiveWindow.ScrollColumn = 11
    

  224.     ActiveWindow.ScrollColumn = 10
    

  225.     ActiveWindow.ScrollColumn = 9
    

  226.     ActiveWindow.ScrollColumn = 8
    

  227.     ActiveWindow.ScrollColumn = 7
    

  228.     ActiveWindow.ScrollColumn = 6
    

  229.     ActiveWindow.ScrollColumn = 5
    

  230.     ActiveWindow.ScrollColumn = 3
    

  231.     ActiveWindow.ScrollColumn = 2
    

  232.     ActiveWindow.SmallScroll Down:=-72
    

  233.     Range("S7:T168,A7:F168").Select
    

  234.     Range("F7").Activate
    

  235.     Selection.Copy
    

  236.     Sheets("Liste des Obso").Select
    

  237.     Cells(Range("K1") + 1, 1).Select
    

  238.     ActiveSheet.Paste
    

  239.     Sheets("Instruction").Select
    

  240.     ActiveWindow.SmallScroll ToRight:=9
    

  241.     ActiveSheet.Range("$A$1:$Y$224").AutoFilter Field:=20
    

  242.     Sheets("Liste des Obso").Select
    

  243.     ActiveWindow.SmallScroll Down:=42
    

  244.     Range("A100:G100").Select
    

  245.     Application.CutCopyMode = False
    

  246.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    

  247.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    

  248.     With Selection.Borders(xlEdgeLeft)
    

  249.         .LineStyle = xlContinuous
    

  250.         .ColorIndex = 0
    

  251.         .TintAndShade = 0
    

  252.         .Weight = xlThin
    

  253.     End With
    

  254.     With Selection.Borders(xlEdgeTop)
    

  255.         .LineStyle = xlContinuous
    

  256.         .ColorIndex = 0
    

  257.         .TintAndShade = 0
    

  258.         .Weight = xlThin
    

  259.     End With
    

  260.     With Selection.Borders(xlEdgeBottom)
    

  261.         .LineStyle = xlContinuous
    

  262.         .ColorIndex = 0
    

  263.         .TintAndShade = 0
    

  264.         .Weight = xlThin
    

  265.     End With
    

  266.     With Selection.Borders(xlEdgeRight)
    

  267.         .LineStyle = xlContinuous
    

  268.         .ColorIndex = 0
    

  269.         .TintAndShade = 0
    

  270.         .Weight = xlThin
    

  271.     End With
    

  272.     Selection.Borders(xlInsideVertical).LineStyle = xlNone
    

  273.     Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    

  274.     With Selection.Interior
    

  275.         .Pattern = xlSolid
    

  276.         .PatternColorIndex = xlAutomatic
    

  277.         .ThemeColor = xlThemeColorAccent5
    

  278.         .TintAndShade = 0.799981688894314
    

  279.         .PatternTintAndShade = 0
    

  280.     End With
    

  281.     Sheets("Liste").Select
    

  282.     ActiveWindow.ScrollColumn = 5
    

  283.     ActiveWindow.ScrollColumn = 6
    

  284.     ActiveWindow.ScrollColumn = 7
    

  285.     ActiveWindow.ScrollColumn = 8
    

  286.     ActiveWindow.ScrollColumn = 9
    

  287.     ActiveWindow.ScrollColumn = 10
    

  288.     ActiveWindow.ScrollColumn = 11
    

  289.     ActiveWindow.ScrollColumn = 12
    

  290.     ActiveWindow.ScrollColumn = 13
    

  291.     ActiveWindow.ScrollColumn = 14
    

  292.     ActiveWindow.ScrollColumn = 15
    

  293.     ActiveWindow.ScrollColumn = 16
    

  294.     ActiveWindow.ScrollColumn = 17
    

  295.     ActiveWindow.ScrollColumn = 16
    

  296.     Columns("R:T").Select
    

  297.     Selection.EntireColumn.Hidden = False
    

  298.     ActiveSheet.Range("$A$1:$V$64").AutoFilter Field:=19, Criteria1:="<>"
    

  299.     ActiveWindow.SmallScroll Down:=-27
    

  300.     Range("R7:S49").Select
    

  301.     ActiveWindow.ScrollColumn = 15
    

  302.     ActiveWindow.ScrollColumn = 14
    

  303.     ActiveWindow.ScrollColumn = 13
    

  304.     ActiveWindow.ScrollColumn = 12
    

  305.     ActiveWindow.ScrollColumn = 11
    

  306.     ActiveWindow.ScrollColumn = 10
    

  307.     ActiveWindow.ScrollColumn = 9
    

  308.     ActiveWindow.ScrollColumn = 7
    

  309.     ActiveWindow.ScrollColumn = 6
    

  310.     ActiveWindow.ScrollColumn = 5
    

  311.     ActiveWindow.ScrollColumn = 4
    

  312.     Range("R7:S49,A7:E49").Select
    

  313.     Range("E7").Activate
    

  314.     Selection.Copy
    

  315.     Sheets("Liste des Obso").Select
    

  316.     Cells(Range("K1") + 2, 1).Select
    

  317.     ActiveSheet.Paste
    

  318.     Sheets("Liste").Select
    

  319.     ActiveWindow.ScrollColumn = 5
    

  320.     ActiveWindow.ScrollColumn = 6
    

  321.     ActiveWindow.ScrollColumn = 7
    

  322.     ActiveWindow.ScrollColumn = 8
    

  323.     ActiveWindow.ScrollColumn = 9
    

  324.     ActiveWindow.ScrollColumn = 10
    

  325.     ActiveWindow.ScrollColumn = 11
    

  326.     ActiveWindow.ScrollColumn = 12
    

  327.     ActiveWindow.ScrollColumn = 13
    

  328.     ActiveWindow.ScrollColumn = 14
    

  329.     ActiveWindow.ScrollColumn = 15
    

  330.     ActiveSheet.Range("$A$1:$V$64").AutoFilter Field:=19
    

  331.     Sheets("Liste des Obso").Select
    

  332.     ActiveWindow.ScrollRow = 94
    

  333.     ActiveWindow.ScrollRow = 92
    

  334.     ActiveWindow.ScrollRow = 90
    

  335.     ActiveWindow.ScrollRow = 87
    

  336.     ActiveWindow.ScrollRow = 85
    

  337.     ActiveWindow.ScrollRow = 81
    

  338.     ActiveWindow.ScrollRow = 79
    

  339.     ActiveWindow.ScrollRow = 76
    

  340.     ActiveWindow.ScrollRow = 73
    

  341.     ActiveWindow.ScrollRow = 70
    

  342.     ActiveWindow.ScrollRow = 68
    

  343.     ActiveWindow.ScrollRow = 65
    

  344.     ActiveWindow.ScrollRow = 62
    

  345.     ActiveWindow.ScrollRow = 60
    

  346.     ActiveWindow.ScrollRow = 57
    

  347.     ActiveWindow.ScrollRow = 55
    

  348.     ActiveWindow.ScrollRow = 53
    

  349.     ActiveWindow.ScrollRow = 51
    

  350.     ActiveWindow.ScrollRow = 49
    

  351.     ActiveWindow.ScrollRow = 48
    

  352.     ActiveWindow.ScrollRow = 45
    

  353.     ActiveWindow.ScrollRow = 44
    

  354.     ActiveWindow.ScrollRow = 42
    

  355.     ActiveWindow.ScrollRow = 41
    

  356.     ActiveWindow.ScrollRow = 39
    

  357.     ActiveWindow.ScrollRow = 38
    

  358.     ActiveWindow.ScrollRow = 36
    

  359.     ActiveWindow.ScrollRow = 35
    

  360.     ActiveWindow.ScrollRow = 34
    

  361.     ActiveWindow.ScrollRow = 33
    

  362.     ActiveWindow.ScrollRow = 32
    

  363.     ActiveWindow.ScrollRow = 31
    

  364.     ActiveWindow.ScrollRow = 30
    

  365.     ActiveWindow.ScrollRow = 28
    

  366.     ActiveWindow.ScrollRow = 27
    

  367.     ActiveWindow.ScrollRow = 26
    

  368.     ActiveWindow.ScrollRow = 25
    

  369.     ActiveWindow.ScrollRow = 23
    

  370.     ActiveWindow.ScrollRow = 22
    

  371.     ActiveWindow.ScrollRow = 21
    

  372.     ActiveWindow.ScrollRow = 20
    

  373.     ActiveWindow.ScrollRow = 19
    

  374.     ActiveWindow.ScrollRow = 18
    

  375.     ActiveWindow.ScrollRow = 17
    

  376.     ActiveWindow.ScrollRow = 16
    

  377.     ActiveWindow.ScrollRow = 15
    

  378.     ActiveWindow.ScrollRow = 14
    

  379.     ActiveWindow.ScrollRow = 13
    

  380.     ActiveWindow.ScrollRow = 12
    

  381.     ActiveWindow.ScrollRow = 11
    

  382.     ActiveWindow.ScrollRow = 10
    

  383.     ActiveWindow.ScrollRow = 9
    

  384.     ActiveWindow.ScrollRow = 8
    

  385.     ActiveWindow.ScrollRow = 7
    

  386.     ActiveWindow.ScrollRow = 6
    

  387.     ActiveWindow.ScrollRow = 5
    

  388.     Columns("A:A").Select
    

  389.     Application.CutCopyMode = False
    

  390.     Selection.Hyperlinks.Delete
    

  391.     Range("A2").Select
    

  392. End Sub

Voici le programme mais je pense qu'il doit y avoir une solution beaucoup plus simple que celle là.
En fait j'ai enregistré une suite de réalisation manuelle dans les différentes feuilles.
J'ai essayé de faire avec la fonction filtre élaboré mais je ne dois pas faire comme il faut car il me dit qua la plage n'est pas valide....

vous verrez aussi que j'ai essayé de mettre une ligne de séparation entre chaque type de documents mais ça ne marche pas parfaitement non plus....

Merci beaucoup pour votre aide.

virginie

Autres pages sur : extraire donnees plusieurs feuilles conditions vers feuille

  • nini623 a édité ce message
Lassé par la pub ? Créez un compte

Salut,

Rhoooolala !

Ca se voit que tu t'es laissée guider par l'enregistreur de macro.
C'est un très bon début. Mais il manque le reste : le nettoyage du code.
Par exemple, les scrolls sont inutiles.
Or sur 392 lignes, on en trouve 214 ! :ouch: 

Par principe, on s'interdit d'utiliser le presse-papier comme mémoire temporaire.
C'est une zone partagée entre toutes les applications du système. Imagine que tous les programmes en fassent autant.
Bonjour la pagaille. On va voir comment faire autrement.

Tu jongles entre plusieurs feuilles, et tu comptes sur le système pour que la feuille, la cellule que tu sélectionnes restent actives.
C'est faire fort confiance à Windows et Excel. Au moindre "popeupètvousur", ta macro est plantée.

Par ailleurs, tu sélectionnes tel objet puis tu agis sur la sélection. Ben et si tu agissais directement sur l'objet ?
Exemple :
  1. ' // Pas terrible
  2. Rows("5:500").Select
  3. Selection.Delete Shift:=xlUp
  4.  
  5. ' // Plus simple, plus logique, plus petit, plus... mieux
  6. Rows("5:500").Delete

(J'ai aussi viré le Shift inutile puisque très intelligemment, tu as utilisé Rows())

Ensuite, je voudrais bien savoir pourquoi tu fais des filters et des masquages de colonnes au fur et à mesure.

Bon, je te laisse nous proposer un code un peu nettoyé.
Ensuite le programme c'est : te montrer comment ne pas passer par le presse-papier en utilisant mieux la méthode Copy() et comment désigner tes objets sans passer par des sélections.
  • zeb a édité ce message
  • zeb a édité ce message

zeb a dit :
Salut,

Rhoooolala !

Ca se voit que tu t'es laissée guider par l'enregistreur de macro.
C'est un très bon début. Mais il manque le reste : le nettoyage du code.
Par exemple, les scrolls sont inutiles.
Or sur 392 lignes, on en trouve 214 ! :ouch: 

Par principe, on s'interdit d'utiliser le presse-papier comme mémoire temporaire.
C'est une zone partagée entre toutes les applications du système. Imagine que tous les programmes en faisaient autant.
Bonjour la pagaille. On va voir comment faire autrement.

Tu jongles entre plusieurs feuilles, et tu comptes sur le système pour que la feuille, la cellule que tu sélectionnes restent actives.
C'est faire fort confiance à Windows et Excel. Au moindre "popeupètvousur", ta macro est plantée.

Par ailleurs, tu sélectionnes tel objet puis tu agis sur la sélection. Ben et si tu agissais directement sur l'objet ?
Exemple :
  1. // Pas terrible
  2. Rows("5:500").Select
  3. Selection.Delete Shift:=xlUp
  4.  
  5. // Plus simple, plus logique, plus petit, plus... mieux
  6. Rows("5:500").Delete

(J'ai aussi viré le Shift inutile puisque très intelligemment, tu as utilisé Rows())

Ensuite, je voudrais bien savoir pourquoi tu fais des filters et des masquages de colonnes au fur et à mesure.

Bon, je te laisse nous proposer un code un peu nettoyé.
Ensuite le programme c'est : te montrer comment ne pas passer par le presse-papier en utilisant mieux la méthode Copy() et comment désigner tes objets sans passer par des sélections.



Merci zeb,
Je me mets au travail et je reviens te montrer le résultat.

Oui, je travaille avec l'enregistreur de macro car j'ai eu une formation où l'on m'a beaucoup expliqué avec ce système. Je souhaitais une formation sur le language afin de mieux s'avoir l'appréhender et l'utiliser avant mais trop cher....
merci pour l'info du presse-papier, je ne savais pas.
Mais je vois que je suis pas si nulle que je le pensais, ça fait plaisir à lire et ça donne confiance.

Pour la question des filtres, c'est que dans cette colonne, je ne veux extraire que les données des lignes où il y a écrit "OBSO" ou "FUTUR OBSO" donc les cases de la colonne "obsolète" ne sont pas vide. Mais dans ces lignes, je ne veux à nouveau que extraire certaines colonnes, pas la ligne entière.

Je vais déjà faire ce que tu me dis et je te montre ce que ça donne début de semaine prochaine.
  • nini623 a édité ce message

bon, comme ça me titille d'avancer sur ce sujet, j'ai essayé de "nettoyer" mon code :

  1. Sub Actualiser()
    

  2. '
    

  3. ' Macro1 Macro
    

  4. '
    

  5.  
  6. '
    

  7.     Rows("5:500").Delete
    

  8.     Range("A5").Select
    

  9.     Sheets("Ancien Systeme").Select
    

  10.     ActiveSheet.Range("$B$1:$W$10").AutoFilter Field:=18, Criteria1:="<>"
    

  11.     Range("R3:S10").Select
    

  12.     Range("R3:S10,B3:E10").Select
    

  13.     Range("E3").Activate
    

  14.     Selection.Copy
    

  15.     Sheets("Liste des Obso").Select
    

  16.     Range("B5").Select
    

  17.     ActiveSheet.Paste
    

  18.     Sheets("Ancien Systeme").Select
    

  19.     ActiveSheet.Range("$B$1:$W$10").AutoFilter Field:=18
    

  20.     Sheets("Procedure").Select
    

  21.     ActiveSheet.Range("$A$1:$X$293").AutoFilter Field:=20, Criteria1:="<>"
    

  22.     Range("S6:T267").Select
    

  23.     Range("A6:F267").Select
    

  24.     Range("F6").Activate
    

  25.     Range("A6:F267,S6:T267").Select
    

  26.     Range("S6").Activate
    

  27.     Selection.Copy
    

  28.     Sheets("Liste des Obso").Select
    

  29.     Cells(Range("K1"), 1).Select
    

  30.     ActiveSheet.Paste
    

  31.     Sheets("Procedure").Select
    

  32.     ActiveSheet.Range("$A$1:$X$293").AutoFilter Field:=20
    

  33.     Sheets("Instruction").Select
    

  34.     Columns("S:U").Select
    

  35.     Selection.EntireColumn.Hidden = False
    

  36.     ActiveSheet.Range("$A$1:$Y$224").AutoFilter Field:=20, Criteria1:="<>"
    

  37.     Range("S7:T168").Select
    

  38.     Range("S7:T168,A7:F168").Select
    

  39.     Range("F7").Activate
    

  40.     Selection.Copy
    

  41.     Sheets("Liste des Obso").Select
    

  42.     Cells(Range("K1") + 1, 1).Select
    

  43.     ActiveSheet.Paste
    

  44.     Sheets("Instruction").Select
    

  45.     ActiveSheet.Range("$A$1:$Y$224").AutoFilter Field:=20
    

  46.     Sheets("Liste des Obso").Select
    

  47.     Sheets("Liste").Select
    

  48.     Columns("R:T").Select
    

  49.     Selection.EntireColumn.Hidden = False
    

  50.     ActiveSheet.Range("$A$1:$V$64").AutoFilter Field:=19, Criteria1:="<>"
    

  51.     Range("R7:S49").Select
    

  52.     Range("R7:S49,A7:E49").Select
    

  53.     Range("E7").Activate
    

  54.     Selection.Copy
    

  55.     Sheets("Liste des Obso").Select
    

  56.     Cells(Range("K1") + 2, 1).Select
    

  57.     ActiveSheet.Paste
    

  58.     Sheets("Liste").Select
    

  59.     ActiveSheet.Range("$A$1:$V$64").AutoFilter Field:=19
    

  60.     Sheets("Liste des Obso").Select
    

  61.     Columns("A:A").Select
    

  62.     Application.CutCopyMode = False
    

  63.     Selection.Hyperlinks.Delete
    

  64.     Range("A2").Select
    

  65.  
  66. End Sub


J'ai aussi enlevé l'histoire de mettre une ligne entre chaque extraction d'une feuille mais je n'ai pas dû enlever tout ce qu'il faut car il me mets encore une ligne mais vide cette fois entre chaque.
Je continue de regarder pour améliorer encore tout ça ;) 
Contenus similaires
Posez votre question

Ah.... :) 
Tu as cet état d'esprit que j'aime tant et qui me fait continuer sur ce forum.

Juste pour faire joli, ajoute le langage à ta balise : [code=VB][/code].

Prenons le premier block.
  1. Rows("5:500").Delete                                                   ' // De quelle feuille ?
  2. Range("A5").Select                                                     ' // Pour quoi faire ?
  3. Sheets("Ancien Systeme").Select                                        ' // zeb à dit : pas de select
  4. ActiveSheet.Range("$B$1:$W$10").AutoFilter Field:=18, Criteria1:="<>"  ' // A revoir
  5. Range("R3:S10").Select                                                 ' // Pour quoi faire ?
  6. Range("R3:S10,B3:E10").Select                                          ' // Cette zone n'est pas fixe !!!!!!!
  7. Range("E3").Activate                                                   ' // Pour quoi faire ?
  8. Selection.Copy                                                         ' // zeb à dit : mieux utiliser la fonction Copy
  9. Sheets("Liste des Obso").Select                                        ' // zeb à dit : pas de select
  10. Range("B5").Select                                                     ' // zeb à dit : pas de select
  11. ActiveSheet.Paste                                                      ' // zeb à dit : pas de presse-papier


Comme on a plusieurs feuilles, on va explicitement les nommer.
  1. ' // Préparation
  2. Dim f_as As Worksheet ' // Feuille Ancient Système
  3. Dim f_lo As Worksheet ' // Feuille liste des obso
  4. Dim f_my As Worksheet ' // Feuille mystère ???
  5.  
  6. Set f_as = Worksheets("Ancien Systeme")
  7. Set f_lo = Worksheets("Liste des Obso")
  8. Set f_my = ActiveSheet
  9.  
  10. ' // Début
  11. f_my.Rows("5:500").Delete


Bon, dans ton code, le filtre te permet de faire "disparaître" des lignes.
Mais la zone R3:S10,B3:E10 est calculé par Excel en fontion du filtre quand tu joues avec ta souris. Pas par macro !!!!
Il va falloir faire nous même cette manip'.
(D'où l'intérêt de ne pas faire de filtre par macro, d'où ma surprise d'en trouver dans ton code)

Q1) Quelle est la zone susceptible de contenir tes données à copier ?
Q2) Quel critère pour choisir une ligne ?
Q3) Quelles colonnes copier ?

Bon, admettons que la réponse à Q1 soit A1:W500
Pour Q2, c'est "OBSO" ou "FUTUR OBSO", disons dans la colonne R. (Mais ce pourrait être "une valeur dans la colonne J" par exemple.)
Pour l'exemple, on peut dire A, C, E, G :spamafote: 

Or donc, on va parcourir toute la zone, ligne par ligne.
Pour chaque ligne on va vérifier si elle nous intéresse.
Puis on va la copier dans la liste des obso'.

Là en core un peu de préparation : où copier ?
  1. Dim cible As Range
  2.  
  3. Set cible = f_lo.Range("A1") '// Peut être voudrais-tu commencer plus bas que la première ligne ?

  1. Dim ligne   as Range ' // 1 ligne
  2. Dim acopier as Range ' // Les cellules à copier
  3.  
  4. For Each ligne In f_as.Rows("1:500")
  5.     ' // La 18ème cellule d'une ligne est dans la colonne R    
  6.     If ligne.Cells(18).Value like "*OBSO" Then
  7.         ' //                            A               C               E               G
  8.         Set acopier = Union(ligne.Cells(1), ligne.Cells(3), ligne.Cells(5), ligne.Cells(7))
  9.         acopier.Copy Destination:=cible
  10.         Set cible = cible.Offset(1)
  11.     End If
  12. Next


Et voilà !
Étudie bien mon exemple. Et généralise pour ton cas.
Regarde bien cette histoire de "cible".
J'attends tes commentaires, tes questions et ton code revu et corrigé.

Pour le prix de 0€, tu vas l'avoir ta formation ;) 
(Mais t'as maintenant des devoirs à faire :lol:  )
  • zeb a édité ce message

ok pour le code, je vais faire mieux avec mon prochain devoir à corriger! :D 

là maintenant le plus dur sera d'attendre lundi de retourner au boulot pour me plonger dans tout ce que tu viens de m'apprendre!!!!!! :pt1cable: 
le week end va être long du coup!!!:lol: 

et merci, j'apprécie vraiment le coup de main pour comprendre ce que je suis en train d'essayer d'écrire! ;) 

Bonjour Zeb,

voilà, je me retrouve bloquée par un message erreur mais je ne comprends pas ce qu'il veut exactement :

  1. Sub Actualiser()
  2. '
  3. ' // Préparation
  4.  
  5. Dim f_pr As Worksheet ' // Feuille Procedure
  6. Dim f_in As Worksheet ' // Feuille Instruction
  7. Dim f_fr As Worksheet ' // Feuille Formulaire
  8. Dim f_li As Worksheet ' // Feuille Liste
  9. Dim f_lo As Worksheet ' // Feuille liste des obso
  10.  
  11. Set f_pr = Worksheets("Procedure")
  12. Set f_in = Worksheets("Instruction")
  13. Set f_fr = Worksheets("Formulaire")
  14. Set f_li = Worksheets("Liste")
  15. Set f_lo = ActiveSheet
  16.  
  17. Dim cible As Range
  18. Dim cible = f_lo.Range ("A5") ' j'ai ce message à ce niveau là :"Erreur de compilation Attendu : fin d'instruction"
  19. Dim ligne As Range
  20. Dim acopier As Range
  21.  
  22.  
  23. ' // Début
  24.  
  25.    f_lo.Rows("5:500").Delete
  26.    For Each ligne In f_pr.Rows("1:500")
  27.         If ligne.Cells(19).Value Like "*OBSO" Then
  28.         Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18))
  29.         acopier.Copy Destination:=cible
  30.         Set cible = cible.Offset(1)
  31.     End If
  32. Next
  33.  
  34. End Sub


Je voulais essayer si ce début marchait mais avec ce message erreur, je n'arrive pas à aller plus loin....

Tu verras que pour le moment, j'ai laissé tomber la feuille ancien système qui de toute façon ne comporte que 5 lignes et je peux facilement les inclure en fin de tableau quand la macro marchera pour les autres feuiles.
Je vais essayer de comprendre déjà ça et je la compliquerais par la suite!
en espérant ne pas trop te décevoir....

Oh, c'est dommage d'avoir été bloquée par si peu. :( 
Remplace *évidemment* Dim par Set à la ligne 18 et continue.

Tu aurais pu le voir quand même :o 
Spoiler
Tu remarqueras que j'ai lâchement édité mon message pour ne pas qu'on voit que l'erreur venait de moi
(ne pas cliquer sur spoiler)

Pour le reste, il me semble que tu as bien compris.

Où enregistres-tu cette fonction ? Dans le code d'une feuille, du classeur, d'un module ?

Dans VBA/Excel, regarde un peu l'aide sur l'Option Explicit et si ce n'est pas encore fait, utilise-la.


A te lire.
  • zeb a édité ce message
  • zeb a édité ce message

zeb a dit :
Oh, c'est dommage d'avoir été bloquée par si peu. :( 
Remplace *évidemment* Dim par Set à la ligne 18 et continue.

Tu aurais pu le voir quand même :o 
Spoiler
Tu remarqueras que j'ai lâchement édité mon message pour ne pas qu'on voit que l'erreur venait de moi
(ne pas cliquer sur spoiler)

Pour le reste, il me semble que tu as bien compris.

Où enregistres-tu cette fonction ? Dans le code d'une feuille, du classeur, d'un module ?

Dans VBA/Excel, regarde un peu l'aide sur l'Option Explicit et si ce n'est pas encore fait, utilise-la.


A te lire.


:lol:  promis, je n'ai pas lu ton spoiler!! :lol: 

J'enregistre cette fonction dans un module et j'ai créé un bouton dans la feuille "liste des obso" auquel j'ai relié la macro. C'est bien ou il y a mieux à faire?

Je ne connaissais pas l'option explicit, je m'en vais de ce pas voir ce que c'est et continuer le code! :) 

Ton code est associé à ta feuille "Liste des obso". Alors mets-le donc là !
Ou bien laisse-le là où il est, ce n'est pas plus mal :spamafote: 

Mais par contre, la ligne 15, ce n'est pas bon !
Par principe, Il ne faut pas faire confiance à ce qui est actif à un moment donné.
  1. Set f_lo = ActiveSheet

Je te laisse corriger ça.

Pour info, si tu avais mis ta fonction dans le code de la feuille, tu aurais pu utiliser le mot-clef me qui se rapporte à la feuille, et ainsi te dispenser de déclarer f_lo. C'est un point de détail. Mais puisque tu es là pour apprendre... ;) 

Bon, je dois faire un truc qui ne va pas....
j'ai mis le code dans la feuille et j'ai donc utilisé le mot clé Me.
J'ai donc supprimé le module existant.
Mais j'ai dû supprimer quelque chose qu'il ne fallait pas....:??: 

Voici mon code :

  1. Sub Actualiser()
  2. '
  3. ' // Préparation
  4.  
  5. Dim f_pr As Worksheet ' // Feuille Procedure
  6. Dim f_in As Worksheet ' // Feuille Instruction
  7. Dim f_fr As Worksheet ' // Feuille Formulaire
  8. Dim f_li As Worksheet ' // Feuille Liste
  9.  
  10. Set f_pr = Worksheets("Procedure")
  11. Set f_in = Worksheets("Instruction")
  12. Set f_fr = Worksheets("Formulaire")
  13. Set f_li = Worksheets("Liste")
  14.  
  15. Dim cible As Range
  16. Set cible = Me.Range("A5")
  17. Dim ligne As Range
  18. Dim acopier As Range
  19.  
  20.  
  21. ' // Début
  22.  
  23. Me.Rows("5:500").Delete
  24. For Each ligne In f_pr.Rows("1:500")
  25.     If ligne.Cells(19).Value Like "*OBSO" Then
  26.     Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18))
  27.     acopier.Copy Destination:=cible
  28.     Set cible = cible.Offset(1)
  29. End If
  30. Next
  31. For Each ligne In f_in.Rows("1:500")
  32.     If ligne.Cells(19).Value Like "*OBSO" Then
  33.     Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18))
  34.     acopier.Copy Destination:=cible
  35.     Set cible = cible.Offset(1)
  36. End If
  37. Next
  38. For Each ligne In f_fr.Rows("1:500")
  39.     If ligne.Cells(19).Value Like "*OBSO" Then
  40.     Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18))
  41.     acopier.Copy Destination:=cible
  42.     Set cible = cible.Offset(1)
  43. End If
  44. Next
  45. For Each ligne In f_li.Rows("1:500")
  46.     If ligne.Cells(19).Value Like "*OBSO" Then
  47.     Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18))
  48.     acopier.Copy Destination:=cible
  49.     Set cible = cible.Offset(1)
  50. End If
  51. Next
  52. End Sub

j'ai remis le code dans un module, histoire déjà de comprendre ce qui ne va pas.
ensuite j'essaierais de simplifier.
je suis en train de chercher ce qui cloche en même temps et j'apprend les définitions de certains termes pour comprendre à quoi ils servent car j'avoue que la fonction "Set cible = cible.Offset(1)" m'étais inconnue.... 

  1. Option Explicit
  2.  
  3. Sub Actualiser()
  4. '
  5. ' // Préparation
  6.  
  7.  
  8. Dim f_pr As Worksheet ' // Feuille Procedure
  9. Dim f_in As Worksheet ' // Feuille Instruction
  10. Dim f_fr As Worksheet ' // Feuille Formulaire
  11. Dim f_li As Worksheet ' // Feuille Liste
  12. Dim f_lo As Worksheet ' // Feuille Liste des Obso
  13.  
  14. Set f_pr = Worksheets("Procedure")
  15. Set f_in = Worksheets("Instruction")
  16. Set f_fr = Worksheets("Formulaire")
  17. Set f_li = Worksheets("Liste")
  18. Set f_lo = Worksheets("Liste des Obso")
  19.  
  20. Dim cible As Range
  21. Set cible = f_lo.Range("A5")
  22. Dim ligne As Range
  23. Dim acopier As Range
  24.  
  25.  
  26. ' // Début
  27.  
  28.  
  29. f_lo.Rows("5:500").Delete
  30. For Each ligne In f_pr.Rows("1:500")
  31.     If ligne.Cells(19).Value Like "*OBSO" Then
  32.     Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18))
  33.     acopier.Copy Destination:=cible
  34.     Set cible = cible.Offset(1)
  35. End If
  36. Next
  37. For Each ligne In f_in.Rows("1:500")
  38.     If ligne.Cells(19).Value Like "*OBSO" Then
  39.     Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18))
  40.     acopier.Copy Destination:=cible
  41.     Set cible = cible.Offset(1)
  42. End If
  43. Next
  44. For Each ligne In f_fr.Rows("1:500")
  45.     If ligne.Cells(19).Value Like "*OBSO" Then
  46.     Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18))
  47.     acopier.Copy Destination:=cible 'j'ai le message erreur d'exécution '1004' la méthode Copy de la classe Range a échoué
  48.     Set cible = cible.Offset(1)
  49. End If
  50. Next
  51. For Each ligne In f_li.Rows("1:500")
  52.     If ligne.Cells(19).Value Like "*OBSO" Then
  53.     Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18))
  54.     acopier.Copy Destination:=cible
  55.     Set cible = cible.Offset(1)
  56. End If
  57. Next
  58. End Sub
  • nini623 a édité ce message

Oh malheur ! :( 
Ligne 21, on définit Cible du côté de la ligne 5.
Ligne 29, on atomise toutes les lignes, de la première à la cinq-centième, en explosant donc Cible.

Une solution toute simple : définir Cible après le Delete !

salut zeb,

ça marche, mais à moitié.
Il me place bien les données de la feuille formulaire et Liste mais pas les données les données des deux premières feuilles.

  1. Option Explicit
  2.  
  3. Sub Actualiser()
  4. '
  5. ' // Préparation
  6.  
  7.  
  8. Dim f_pr As Worksheet ' // Feuille Procedure
  9. Dim f_in As Worksheet ' // Feuille Instruction
  10. Dim f_fr As Worksheet ' // Feuille Formulaire
  11. Dim f_li As Worksheet ' // Feuille Liste
  12. Dim f_lo As Worksheet ' // Feuille Liste des Obso
  13.  
  14. Set f_pr = Worksheets("Procedure")
  15. Set f_in = Worksheets("Instruction")
  16. Set f_fr = Worksheets("Formulaire")
  17. Set f_li = Worksheets("Liste")
  18. Set f_lo = Worksheets("Liste des Obso")
  19.  
  20. 'nettoyage de la feille
  21.  
  22. f_lo.Rows("5:500").Delete
  23.  
  24. ' définition de la cible
  25.  
  26. Dim cible As Range
  27. Set cible = f_lo.Range("A5")
  28. Dim ligne As Range
  29. Dim acopier As Range
  30.  
  31. For Each ligne In f_pr.Rows("1:500")
  32.     If ligne.Cells(19).Value Like "*OBSO" Then
  33.     Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18), ligne.Cells(19))
  34.     acopier.Copy Destination:=cible
  35.     Set cible = cible.Offset(1)
  36.     End If
  37. Next
  38. For Each ligne In f_in.Rows("1:500")
  39.     If ligne.Cells(19).Value Like "*OBSO" Then
  40.     Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18), ligne.Cells(19))
  41.     acopier.Copy Destination:=cible
  42.     Set cible = cible.Offset(1)
  43.     End If
  44. Next
  45. For Each ligne In f_fr.Rows("1:500")
  46.     If ligne.Cells(19).Value Like "*OBSO" Then
  47.     Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18), ligne.Cells(19))
  48.     acopier.Copy Destination:=cible
  49.     Set cible = cible.Offset(1)
  50.     End If
  51. Next
  52. For Each ligne In f_li.Rows("1:500")
  53.     If ligne.Cells(19).Value Like "*OBSO" Then
  54.     Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18), ligne.Cells(19))
  55.     acopier.Copy Destination:=cible
  56.     Set cible = cible.Offset(1)
  57.     End If
  58. Next
  59. End Sub

Salut,

>> ça marche,
Ah... :) 

>> mais à moitié.
Ohhh :( 

--------

Respecte bien le principe d'indentation. Par exemple, tes lignes 33, 34, 35 doivent être tabulées une fois de plus.
Oui, je sais, c'est du pinaillage. Mais n'es-tu pas là pour apprendre :à

--------

Mets l'instruction Stop (va voir dans l'aide à quoi elle sert. Je me dis que tu peux quand même deviner ;)  ) entre les lignes 37 et 38.
Relance. Et arrête ta macro. Ceci pour se concentrer sur la première partie du code.

Vérifie que tu as bien des lignes qui contiennent "OBSO" dans la cellule 19, sans espace après, etc.
Fais-toi un classeur de test pour en être sûr. Ajoute une ligne 1 que tu rempliras à la main et apprends à déboguer toute seule (*) : http://www.presence-pc.com/forum/ppc/Programmation/tuto...

______
(*) Je reste là, hein ;) 

hello!!

:)  voilà, tout le programme marche!
je suis super contente d'avoir réussi, merci beaucoup pour ton aide si précieuse!!! ;) 

j'ai juste une dernière question, sur un autre fichier, j'ai créé une autre macro qui marche, grâce à ce que j'ai appris ici!
mais j'ai voulu y incure un bouton "QUITTER" pour femer le fichier ouvert. Sauf que biensûr, j'ai mis "application.quit" donc il me ferme tous les fichiers excel ouvert ....
Il faut que je définisse mon fichier et ensuite que je lui dise de le fermer, c'est ça?

finalement, j'ai autre chose à te demander.....:ange: 

voilà, j'ai utilisé le code dans un autre fichier semblable mais on m'a demandé de pouvoir trier les documents par service émetteur et par condition. J'ai immédiatement pensé à inclure deux autres userform avec combobox pour utiliser une liste de choix et aller copier les réponses dans la feuille et utiliser ces réponses comme données d'entrée de mon tri en colonne L et M.
Mon soucis est le bout de code " If ligne.Cells(20).Value Like "*OBSO" Then" car j'aimerais qu'il aille chercher la valeur a un endroit donné et non pas la définir directement dans le code et lui ajouter le choix du service émetteur.
L'endroit donné étant défini grâce à mes userform 10 et 11 dans le code.

  1. Private Sub CommandButton8_Click()
  2. '
  3. ' // Préparation
  4.  
  5.  
  6. Dim f_pr As Worksheet ' // Feuille Procedure
  7. Dim f_in As Worksheet ' // Feuille Instruction
  8. Dim f_fr As Worksheet ' // Feuille Formulaire
  9. Dim f_li As Worksheet ' // Feuille Liste
  10. Dim f_lo As Worksheet ' // Feuille Extraction Obso
  11.  
  12. Set f_pr = Worksheets("Procedure")
  13. Set f_in = Worksheets("Instruction")
  14. Set f_fr = Worksheets("Formulaire")
  15. Set f_li = Worksheets("Liste")
  16. Set f_lo = Worksheets("Extraction Obso")
  17.  
  18. 'nettoyage de la feille
  19.  
  20. f_lo.Rows("2:500").Delete
  21.  
  22. 'définition des valeurs service et condition
  23. UserForm10.Show '// mets la valeurs de la condition en L2 de la Feuille Extraction Obso
  24. UserForm11.Show '// mets la valeurs du service émetteur en M2 de la Feuille Extraction Obso
  25.  
  26. ' définition de la cible
  27.  
  28. Dim cible As Range
  29. Set cible = f_lo.Range("A2")
  30. Dim ligne As Range
  31. Dim acopier As Range
  32.  
  33. For Each ligne In f_pr.Rows("1:500")
  34.     If ligne.Cells(20).Value Like "*OBSO" Then
  35.         Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(5), ligne.Cells(6), ligne.Cells(19), ligne.Cells(20))
  36.         acopier.Copy Destination:=cible
  37.         Set cible = cible.Offset(1)
  38.     End If
  39. Next
  40.  
  41. For Each ligne In f_in.Rows("1:500")
  42.     If ligne.Cells(20).Value Like "*OBSO" Then
  43.         Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(5), ligne.Cells(6), ligne.Cells(19), ligne.Cells(20))
  44.         acopier.Copy Destination:=cible
  45.         Set cible = cible.Offset(1)
  46.     End If
  47. Next
  48. For Each ligne In f_fr.Rows("1:500")
  49.     If ligne.Cells(19).Value Like "*OBSO" Then
  50.         Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18), ligne.Cells(19))
  51.         acopier.Copy Destination:=cible
  52.         Set cible = cible.Offset(1)
  53.     End If
  54. Next
  55. For Each ligne In f_li.Rows("1:500")
  56.     If ligne.Cells(19).Value Like "*OBSO" Then
  57.         Set acopier = Union(ligne.Cells(1), ligne.Cells(2), ligne.Cells(3), ligne.Cells(4), ligne.Cells(5), ligne.Cells(18), ligne.Cells(19))
  58.         acopier.Copy Destination:=cible
  59.         Set cible = cible.Offset(1)
  60.     End If
  61. Next
  62. Sheets("Extraction Obso").Select
  63.     Range("A1").Select
  64.     UserForm1.Hide
  65. End Sub
  • nini623 a édité ce message
  • nini623 a édité ce message

Salut,

Eh, moi aussi je suis content que ça marche :) 

Douillou spique angliche ?
Parce que quitter, ça se dit to quit et fermer, ça se dit to close.

Or toi, tu ne veux pas quitter l'application, tu veux fermer ton classeur. Alors tu prends ton classeur (tip: c'est un workbook) et tu le fermes.

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

Bon, je suis informaticien et je n'aime vraiment pas faire deux fois la même chose. Alors quand je vois que nous faisons 4 fois la même choses... argggh ! X_x

Regarde ça :
  1. Dim feuille As Worksheet
  2. For Each feuille In Array(f_pr, f_in, f_fr, f_li)
  3.     For Each ligne In feuille.Rows("1:500")
  4.         If ligne.Cells(20).Value Like "*OBSO" Then
  5.             Set acopier = Nothing
  6.             For Each i In Array(1, 2, 3, 5, 6, 19, 20)
  7.                 Set acopier = IIf(acopier Is Nothing, ligne.Cells(i), Union(acopier, ligne.Cells(i)))
  8.             Next
  9.             acopier.Copy Destination:=cible
  10.             Set cible = cible.Offset(1)
  11.         End If
  12.     Next
  13. Next


Bon, il y a une monstruosité dans ce code. C'est le Rows("1:500"). D'où sort ce 500 ?
(Si je lève le lièvre, c'est que j'ai des trucs à te montrer ;)  T'es toujours là pour apprendre ?)

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

Bon, donc attention. Le code proposé avec l'opérateur Like est encore un truc de fainéantinformaticien pour ne pas trop en écrire. LIKE "*MOT" signifie : qui se termine par "MOT". Or maintenant, ce mot est à chercher dans une cellule, ce n'est pas pareil.

Il faudra écrire : Value = "MOT"
Où est MOT ?
Dans une cellule : 
  1. Value = feuille.Range("Xn")

Dans une variable : 
  1. Dim Xn As String
  2. Value = Xn


Qu'est-ce que le service émetteur ?
Une autre colonne ?
Bon :
  1. If ligne.Cells(20).Value = "MOT" And ligne.Cells(autre_colonne).Value = "service émetteur" Then ..

yes, i speak english very well ( :/  ) but sometimes my blonde highlights stand out....:D 
avec un close, ça va beaucoup mieux.....:ange: 

"Bon, il y a une monstruosité dans ce code. C'est le Rows("1:500"). D'où sort ce 500 ?
(Si je lève le lièvre, c'est que j'ai des trucs à te montrer T'es toujours là pour apprendre ?)"

OUI OUI, je suis toujours là pour apprendre! of course!!!!
le 500, c'est juste pour sélectionner un certains nombre de ligne..... et j'ai pris large pour être sûre de tout sélectionner....

Pour une question d'estétique du fichier, je démarre ma macro d'une feuille qui s'appelle Menu dans laquelle j'ai placé un bouton relié à cette macro.

Pour la condition et le service émetteur, je les place grâce à combobox dans les cellules L2 et M2 de la feuille "Extraction Obso" ou f_lo puisse que nous l'avons définie ainsi.
Donc, quand je clique sur mon bouton d'extraction (situé dans la feuille Menu), une première fenêtre me propose de choisir entre trois conditions : OBSO, FUTUR OBSO ou *OBSO (et place celle choisie dans la case L2 de la feuille f_lo puis une deuxième fenêtre me demande de choisir le service concerné : Achats, AQ, CQ, Info, Maintenance, Logistique.....etc (et place celui choisi dans la case M2 de la feuille f_lo)
Maintenant, il faut extraire de toutes les feuilles f_pr, f_in, f_fr, f_li les colonnes voulues des lignes qui remplissent ces deux conditions et les placer les unes à la suite des autres dans la feuille "Extraction Obso".

Le service émetteur se situe dans la colonne 6 et la condition dans la colonne 20 de chaque feuille.

Voilà, ça te donne plus d'infos sur ma façon d'exécuter la macro.




500 pour faire large. Mauvaise réponse !

D'abord la leçon : http://www.presence-pc.com/forum/ppc/Programmation/tuto...

Ensuite l'exercice. Remplace dans ton code le nombre 500 par le nombre exact de lignes.

Les questions (pertinentes) sont les bienvenues.

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

"*OBSO" est-ce une valeur ou bien est-ce pour dire que seules les dernières lettres sont significatives ?
Dans le premier cas, on mettra un signe égal dans la clause If, dans l'autre on laissera le Like.

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

Je ne vois pas ce qui te bloque pour que tu le fasses toi-même.
A la rigueur, propose un truc - même s'il ne marche pas, et on en discute.

ben c'est que mon nombre de lignes varie toujours, donc pour être sûre de prendre "tout le monde", j'ai mis 500....
merci pour le tutoriel, j'irais zieuter pour améliorer ma mauvaise réponse et essayer d'en proposer une meilleure!

pour le "*OBSO", non, c'est que dans une colonne, j'ai une condition en fonction des dates. Mes documents sont valides un certain temps donc pour pouvoir faire ressortir les documents devenu obsolète et les document arrivant a obsolescence dans les 3 prochains mois, j'ai mis une formule dans une colonne qui me donne de ce fait soit OBSO soit FUTUR OBSO. Et du coup, pour choisir les deux conditions, ben je mets "*OBSO" pour rechercher les lignes qui contiennent le mot OBSO.
Mais comme rien est simple, forcément, il faut pouvoir extraire soit OBSO, soit FUTUR OBSO, soit les deux!
et par service en plus, car chaque service veut pouvoir faire cette extraction pour son propre service et pas être pollué par les documents des autres services.

Pour répondre à ta question sur ce qui me bloque, pour l'instant, c'est le temps que je peux consacrer sans être déranger au bureau. Dans un bureau de trois avec du passage, c'est difficile de se concentrer et du coup, il y a des moments où tout se mélange et devient du chinois pour moi....:( 
Mais je ne désespère pas ;)  , je mets à profit les moments du midi et la fin d'après-midi quand je peux fermer la porte du bureau et ainsi m'isoler. Malheureusement, ça ne me laisse pas énormément de temps...
enfin, bref, je ne vais pas raconter ma vie, je ne suis pas ici pour ça.

J'ai essayé qlq chose ce midi mais j'ai un message erreur, je posterais mon code revu et réduit :)  j'espère demain ou vendredi pour voir ce que tu en penses.
Merci pour ta patience!

Ma patience ?! Elle est infinie. Ici c'est un forum, pas un tchat. Aucun problème de longueur de temps.
(T'as qu'à voir ma réaction quand un guguss met "URGENT !!!!!!!!!!!" dans le titre de son sujet :lol:  )

A te lire.

zeb a dit :
Ma patience ?! Elle est infinie. Ici c'est un forum, pas un tchat. Aucun problème de longueur de temps.
(T'as qu'à voir ma réaction quand un guguss met "URGENT !!!!!!!!!!!" dans le titre de son sujet :lol:  )

A te lire.



Bonjour Zeb,

dans un premier temps, j'ai essayé de simplifier mais je dois zapper qlq chose ou j'ai pas compris....:/
J'ai noté dans le code le message erreur :


  1. Private Sub CommandButton8_Click()
  2. '
  3. ' // Préparation
  4.  
  5.  
  6. Dim f_pr As Worksheet ' // Feuille Procedure
  7. Dim f_in As Worksheet ' // Feuille Instruction
  8. Dim f_fr As Worksheet ' // Feuille Formulaire
  9. Dim f_li As Worksheet ' // Feuille Liste
  10. Dim f_lo As Worksheet ' // Feuille Extraction Obso
  11.  
  12. Set f_pr = Worksheets("Procedure")
  13. Set f_in = Worksheets("Instruction")
  14. Set f_fr = Worksheets("Formulaire")
  15. Set f_li = Worksheets("Liste")
  16. Set f_lo = Worksheets("Extraction Obso")
  17.  
  18.  
  19. 'nettoyage de la feuille
  20.  
  21. f_lo.Rows("2:500").Delete
  22.  
  23. 'définition des valeurs service et condition
  24. UserForm10.Show '// mets la valeurs de la condition en L2 de la Feuille Extraction Obso
  25. UserForm11.Show '// mets la valeurs du service émetteur en M2 de la Feuille Extraction Obso
  26.  
  27. ' définition de la cible
  28.  
  29. Dim cible As Range
  30. Set cible = f_lo.Range("A2")
  31. Dim ligne As Range
  32. Dim acopier As Range
  33.  
  34. Dim feuille As Worksheet
  35.  
  36. For Each feuille In Array(f_pr, f_in, f_fr, f_li)  'message d'erreur 424 objet requis
  37.     For Each ligne In feuille.Rows("1:500")
  38.         If ligne.Cells(20).Value Like "*OBSO" Then
  39.             Set acopier = Nothing
  40.             For Each i In Array(1, 2, 3, 5, 6, 19, 20)
  41.                 Set acopier = IIf(acopier Is Nothing, ligne.Cells(i), Union(acopier, ligne.Cells(i)))
  42.             Next
  43.             acopier.Copy Destination:=cible
  44.             Set cible = cible.Offset(1)
  45.         End If
  46.     Next
  47. Next
  48.  
  49.  
  50. Sheets("Extraction Obso").Select
  51.     Range("A1").Select
  52.     UserForm1.Hide
  53. End Sub

Oups.
Ce n'est pas ta faute.

C'est la mienne - un peu - car je n'ai pas vérifié.
Et c'est celle de Microsoft - beaucoup, énormément - parce que ces sal[:zeb:7]rds n'ont pas fini le modèle objet de leur langage.
:pfff: 

Bref.
De façon assez dégueulasse pas jolie, remplace la ligne 34 par :
  1. Dim feuille As Worksheet ' <-- Pas bon :(
  2. Dim feuille As Variant   ' <-- Bon --- :( Quoi que
  • zeb a édité ce message

yes, j'ai trouvé aussi! en cherchant bien, des fois on trouve!! :) 

maintenant, je cherche la solution au nouveau message erreur.... lol
je suis en train de regarder dans l'aide ;) 

  1. Private Sub CommandButton8_Click()
  2. '
  3. ' // Préparation
  4.  
  5.  
  6. Dim f_pr As Worksheet ' // Feuille Procedure
  7. Dim f_in As Worksheet ' // Feuille Instruction
  8. Dim f_fr As Worksheet ' // Feuille Formulaire
  9. Dim f_li As Worksheet ' // Feuille Liste
  10. Dim f_lo As Worksheet ' // Feuille Extraction Obso
  11.  
  12. Set f_pr = Worksheets("Procedure")
  13. Set f_in = Worksheets("Instruction")
  14. Set f_fr = Worksheets("Formulaire")
  15. Set f_li = Worksheets("Liste")
  16. Set f_lo = Worksheets("Extraction Obso")
  17.  
  18.  
  19. 'nettoyage de la feuille
  20.  
  21. f_lo.Rows("2:500").Delete
  22.  
  23. 'définition des valeurs service et condition
  24. UserForm10.Show '// mets la valeurs de la condition en L2 de la Feuille Extraction Obso
  25. UserForm11.Show '// mets la valeurs du service émetteur en M2 de la Feuille Extraction Obso
  26.  
  27. ' définition de la cible
  28.  
  29. Dim cible As Range
  30. Set cible = f_lo.Range("A2")
  31. Dim ligne As Range
  32. Dim acopier As Range
  33.  
  34. Dim feuille As Variant
  35.  
  36. For Each feuille In Array(f_pr, f_in, f_fr, f_li)
  37.     For Each ligne In feuille.Rows("1:500")
  38.         If ligne.Cells(20).Value Like "*OBSO" Then
  39.             Set acopier = Nothing
  40.             For Each i In Array(1, 2, 3, 5, 6, 19, 20)
  41.                 Set acopier = IIf(acopier Is Nothing, ligne.Cells(i), Union(acopier, ligne.Cells(i))) 'message d'erreur 5 argument ou appel incorrect
  42.             Next
  43.             acopier.Copy Destination:=cible
  44.             Set cible = cible.Offset(1)
  45.         End If
  46.     Next
  47. Next
  48.  
  49.  
  50. Sheets("Extraction Obso").Select
  51.     Range("A1").Select
  52.     UserForm1.Hide
  53. End Sub

Et Zut ! Là, c'est ma faute à ma tout seul :/ 
En fait, Union() est assez mal fichu.

A la ligne 41, j'aurai voulu écrire :
  1. acopier = acopier + ligne.Cells(i)

Pour ajouter une cellule à une plage.

Bon, en VB, ça s'écrit avec un Set et un Union(). :sarcastic: 
  1. Set acopier = Union(acopier, ligne.Cells(i))


Sauf que si acopier est vide, ça plante.

Donc j'ai voulu écrire :
  1. If acopier Is Nothing Then
  2.     Set acopier = ligne.Cells(i)
  3. Else
  4.     Set acopier = Union(acopier, ligne.Cells(i))
  5. End If


Comme il commençait à y avoir beaucoup de choses imbriquées, j'ai voulu jouer au plus malin en transformant le If .. Then .. Else en Iif().
Sauf que Iif() est une fonction et que tous les paramètres sont évalués avant que ne commence la fonction. Et donc le code plante sur le troisière paramètre quand acopier est vide, ce que justement je voulais éviter.

:honte:

Bon, dans ces cas-là, il faut soit accepter d'imbriquer beaucoup de choses, soit il faut créer une sous-fonction.
Je choisis la seconde solution pour rester cohérent avec moi-même.

Et je crée ma propre fonction Union(). Elle s'appelle zUnion() :sol: 

  1. Private Function zUnion(ParamArray range1()) As Range
  2.     Dim result As Range
  3.     Dim r      As Variant
  4.  
  5.     For Each r In range1
  6.         If Not r Is Nothing Then
  7.             If result Is Nothing Then
  8.                 Set result = r
  9.             Else
  10.                 Set result = Union(result, r)
  11.             End If
  12.         End If
  13.     Next
  14.  
  15.     Set zUnion = result
  16. End Function


Et maintenant, la ligne 41 :
  1. Set acopier = Union(acopier, ligne.Cells(i))


Et voilou !

:bounce: 
impec, ça marche! Je te remercie énormément!

maintenant, je vais m'atteler à regarder ce que tu me disais sur un message précédent pour l'extraction avec une valeur se situant dans une cellule et aussi l'énormité que tu as relevé avec mes lignes (500)....

euh, petite question con d'une non informaticienne : l'envirronement (windows 7, xp...) peut jouer sur l'éxécution des macros?

Citation :
[..] ça marche! Je te remercie [..]

Ahhhh !Ça fait plaisir. :) 

Les macro-commandes sont associées à un logiciel - en l'occurrence Excel - pas à un système d'exploitation.
Attention cependant, il peut y avoir des différences entre les versions d'Excel.
Mais c'est très rare et la rétrocompatibilité est très importante pour les éditeurs comme Microsoft, quitte à reconduire exprès des bogues.
De Bill Gates cette maxime : It's not a bug, it's a feature.


En attendant la suite ...
:) 

ok, merci! je demandais ça car je rencontre beaucoup de problème de compatibilité entre les versions d'excel sur le parc informatique.
Les macros créées avec un excel 2000 ou 2003 ne marchent pas forcément sous 2010....
et je dois aussi gérer plusieurs versions d'un même fichier afin que toutes le monde puisse utiliser ces fichiers suivant leur versions d'excel!:pt1cable: 

pour la suite, se sera fin de semaine car là, je suis malade...:( 

hello!
bon, me revoilà reparti dans les macros!!! :)  après plus d'un mois sans y avoir touché une seule fois....
faut que je me remette dedans!

je suis, du coup, toujours au même point qu'avant, je cherche comment lui dire d'extraire les données non pas directement en lui mettant la condition mais qu'il aille la chercher dans une case la contenant.

mes conditions se trouve dans la feuille "Extraction Obso" avec la condition en "L2" et le service en "M2" qui y sont placé grâce à deux combobox.

  1. Private Sub CommandButton8_Click()
  2. '
  3. ' // Préparation
  4.  
  5.  
  6. Dim f_pr As Worksheet ' // Feuille Procedure
  7. Dim f_in As Worksheet ' // Feuille Instruction
  8. Dim f_fr As Worksheet ' // Feuille Formulaire
  9. Dim f_li As Worksheet ' // Feuille Liste
  10. Dim f_lo As Worksheet ' // Feuille Extraction Obso
  11.  
  12. Set f_pr = Worksheets("Procedure")
  13. Set f_in = Worksheets("Instruction")
  14. Set f_fr = Worksheets("Formulaire")
  15. Set f_li = Worksheets("Liste")
  16. Set f_lo = Worksheets("Extraction Obso")
  17.  
  18.  
  19. 'nettoyage de la feuille
  20.  
  21. f_lo.Rows("2:500").Delete
  22.  
  23. 'définition des valeurs service et condition
  24. UserForm10.Show '// mets la valeurs de la condition en L2 de la Feuille Extraction Obso
  25. UserForm11.Show '// mets la valeurs du service émetteur en M2 de la Feuille Extraction Obso
  26.  
  27. ' définition de la cible
  28.  
  29. Dim cible As Range
  30. Set cible = f_lo.Range("A2")
  31. Dim ligne As Range
  32. Dim acopier As Range
  33.  
  34. Dim feuille As Variant
  35.  
  36. For Each feuille In Array(f_pr, f_in, f_fr, f_li)
  37.     For Each ligne In feuille.Rows("1:500")
  38.         If ligne.Cells(20).Value Like "*OBSO" Then
  39.             Set acopier = Nothing
  40.             For Each i In Array(1, 2, 3, 5, 6, 19, 20)
  41.                 Set acopier = zUnion(acopier, ligne.Cells(i))
  42.             Next
  43.             acopier.Copy Destination:=cible
  44.             Set cible = cible.Offset(1)
  45.         End If
  46.     Next
  47. Next
  48.  
  49.  
  50. Sheets("Extraction Obso").Select
  51.     Range("A1").Select
  52.     UserForm1.Hide
  53. End Sub


voilà, je me replonge dans ce monde afin de finaliser enfin cette partie de programme!

il faut que je modifie donc la ligne 38 du code avec ce que tu m'avais donné comme info :
Value = "MOT"
Où est MOT ?
Dans une cellule :
1.Value = feuille.Range("Xn")

Qu'est-ce que le service émetteur ?
Une autre colonne ?
Bon :
1.If ligne.Cells(20).Value = "MOT" And ligne.Cells(autre_colonne).Value = "service émetteur" Then ..

nini

Salut Nini, ça va mieux ?

  1. Dim f_eo As Worksheet
  2. Set f_eo = Worksheets("Extraction Obso")
  3.  
  4. ...
  5.  
  6. If ligne.Cells(20).Value = f_eo.Range("L2").Value And _
  7.    ligne.Cells(autre_colonne).Value =  f_eo.Range("M2").Value Then ..


C'est ça qu'on cherche depuis 50 jours ?
Comprends pas ce qui n'est pas compréhensible.
C'est d'ailleurs toute la difficulté d'aider les autres ! :o 

50 jours? euh, nan, juste depuis hier en fait et un peu avant que je sois malade mais je ne me souvenais plus du tout de ce que j'avais fait....
merci, je vais beaucoup mieux! ;) 
Mais tu es le meilleur, tu as compris parfaitement ce que je voulais faire! :sol: 
c'est vrai que c'est pas facile de s'exprimer par écrit sur ce genre de problème...désolée si je n'ai pas toujours été très claire!

j'avais fait ce que tu as mis mais j'avais un message erreur que je ne comprenais pas avant de voir le "_" derrière le And de ta ligne 6, tu peux me dire à quoi il sert?
  • nini623 a édité ce message
  • nini623 a édité ce message
  • nini623 a édité ce message
  • nini623 a édité ce message

par contre, j'ai un problème quand la condition est "*OBSO", il ne m'extrait rien....
ça marche parfaitement avec la condition "OBSO" ou 'FUTUR OBSO" mais quand je lui demande "*OBSO", il ne comprend pas qu'il faut prendre qui contient OBSO? il y a une particularité pour ce cas là?

Salut Nini,

A moi de t'abandonner pour cause de convalescence : 20 jours de repos forcé (ne joue jamais au Rugby, c'est un sport de brute !)
Mais me revoici !!!!

Le petit souligné [_] à la fin d'une ligne permet de passer à la ligne.
Le VBA est basé sur le BASIC, un langage archaïque dont il garde certains défauts. :spamafote: 

Quant à l'utilisation de l'astérisque
  • , il faut utiliser le comparateur Like et non pas l'habituel signe égal [=]
    Et bien vérifier que l'expression est bien déterminante.
    • Lassé par la pub ? Créez un compte
     
    Posez votre question