Se connecter avec
S'enregistrer | Connectez-vous
Votre question
Résolu

Extraire des données de plusieurs feuilles avec conditions vers d'autres feuilles VBA

Dernière réponse : dans Programmation
Partagez
24 Février 2012 12:55:12

Bonjour,

Je commence à m’intéresser à VBA pour mon travail, et comme je débute je ne comprends pas tout ! :D 

J’ai regardé dans différents sujets et j’ai trouvé des choses qui se rapprochent de ce que je veux faire. j'écris donc mon premier programme VBA!! :D 
je me suis basé sur ce sujet http://www.presence-pc.com/forum/id-2105597/extraire-donnees-plusieurs-feuilles-conditions-vers-feuille.html (et grâce aux explications de zeb, j'ai grandement progressé!!) Il se rapproche un peu... actuellement je bloque sur la concaténation de cellule, je m'explique: dans mon 2éme If je voudrais insérer une concaténation de nom de site utilisé en fonction de la valeur... sur l'image on comprend mieux!! :lol: 

Je n'ai aucune idée de comment faire...

Ci dessous mon code qui pour le moment ne fait "que" copier des données en fonction de valeur.
D'ailleurs je n'arrive pas à intégrer ce code http://www.presence-pc.com/forum/ppc/Programmation/tutoriel-excel-macro-trucs-astuces-sujet-4953-1.htm#8248701qui permettrait d’être plus propre et de faire une mise en page correcte (ligne de tableau par exemple.)

  1. Sub Macro_recrutement()
  2. '
  3. ' // Préparation
  4.  
  5. Dim f_re As Worksheet ' // Feuille recrutement
  6. Dim f_dest As Worksheet ' // Feuille destination
  7. Dim f_dest1 As Worksheet ' // Feuille destination
  8. Dim f_dest2 As Worksheet ' // Feuille destination
  9.  
  10. Set f_re = Worksheets("Recrutement")
  11. Set f_dest = Worksheets("Formation du recruté ")
  12. Set f_dest1 = Worksheets("Sites utilisés et nbre candid")
  13. Set f_dest2 = Worksheets("Feuil1")
  14.  
  15.  
  16. f_dest.Rows("5:500").Delete ' //Je sais que ce n'est pas propre mais je n'arrive pas à le faire par le code...
  17.  
  18.  
  19. Dim cible As Range
  20. Set cible = f_dest.Range("A5")
  21. Dim cible1 As Range
  22. Set cible1 = f_dest1.Range("A4")
  23. Dim cible2 As Range
  24. Set cible2 = f_dest2.Range("A4")
  25. Dim ligne As Range
  26. Dim acopier As Range
  27.  
  28.  
  29.  
  30. ' // Début
  31.  
  32.  
  33. For Each ligne In f_re.Rows("6:500")
  34.  
  35. If ligne.Cells(35).Value Like "RETENU" Then
  36. Set acopier = Union(ligne.Cells(36), ligne.Cells(29), ligne.Cells(5))
  37. acopier.Copy Destination:=cible
  38. Set cible = cible.Offset(1)
  39. With f_dest.Rows("5:500")
  40. .Borders(xlDiagonalDown).LineStyle = xlNone 'il faut mettre xlCOntinuous pour faire un trait
  41. .Borders(xlDiagonalUp).LineStyle = xlNone
  42. .Borders(xlEdgeLeft).LineStyle = xlNone
  43. .Borders(xlEdgeTop).LineStyle = xlNone
  44. .Borders(xlEdgeBottom).LineStyle = xlNone
  45. .Borders(xlEdgeRight).LineStyle = xlNone
  46. .Borders(xlInsideVertical).LineStyle = xlNone
  47. .Borders(xlInsideHorizontal).LineStyle = xlNone
  48. .Interior.ColorIndex = xlNone
  49. .Font.Bold = False
  50. .Font.Color = vbBlack
  51. End With
  52.  
  53. End If
  54.  
  55.  
  56. If ligne.Cells(24).Value <> "" Then
  57. Set acopier = Union(ligne.Cells(5), ligne.Cells(10), ligne.Cells(24))
  58. acopier.Copy Destination:=cible1
  59. Set cible1 = cible1.Offset(1)
  60. With f_dest1.Rows("4:500")
  61. .Borders(xlDiagonalDown).LineStyle = xlNone 'il faut mettre xlCOntinuous pour faire un trait
  62. .Borders(xlDiagonalUp).LineStyle = xlNone
  63. .Borders(xlEdgeLeft).LineStyle = xlNone
  64. .Borders(xlEdgeTop).LineStyle = xlNone
  65. .Borders(xlEdgeBottom).LineStyle = xlNone
  66. .Borders(xlEdgeRight).LineStyle = xlNone
  67. .Borders(xlInsideVertical).LineStyle = xlNone
  68. .Borders(xlInsideHorizontal).LineStyle = xlNone
  69. .Interior.ColorIndex = xlNone
  70. .Font.Bold = False
  71. .Font.Color = vbBlack
  72. End With
  73.  
  74. End If
  75.  
  76. Next
  77.  
  78. Sheets("Feuil1").Select
  79. Range("A1").Select
  80.  
  81.  
  82. End Sub





Merci beaucoup pour votre aide!!

Guillaume
24 Février 2012 16:54:32

Petite précision: j'ai réussi à faire la concaténation en formule (même moi je trouve pas ça très propre... :S)


avec;
CELLULE G5 ..... Cellule n ... Cellule O5
=SI(Recrutement!L6<>"";Recrutement!L$5;"")..... ... = SI(Recrutement!V6<>"";Recrutement!L$5;"")

pour réaliser la concaténation j'ai donc en cellule L5:
=CONCATENER(G5;" ";H5;" ";I5;" ";J5;" ";K5;" ";L5;" ";M5;" ";N5;" ";O5)
Avec ca j'ai bien la réponse souhaité...

sous VBA il va falloir utiliser un truc du genre?

  1. range("O2").Formula ="=CONCATENATE($K2,""-"",$L2,""-"",$M2,""-"",$N2,""-"",$H2)"


dans l'aide Exel je trouve ca:
  1. Var1 = "34": Var2 = "6" ' Initialise les variables contenant des chaînes.
  2. MyNumber = Var1 + Var2 ' Renvoie "346" (concaténation des chaînes).


mais il me faut séparer les valeurs (pour la lisibilité), devrais-je faire une boucle pour: si le site X est utilisé mettre cette valeur dans une variable ( de meme pour les autres sites) et utiliser la formule pour concaténer tout ca?? :heink: 
m
0
l
27 Février 2012 13:17:31

J'ai une autre question:
quand je mets ca
  1. If ligne.Cells(35).Value Like "RETENU" Then
  2. Set acopier = (ligne.Cells(5), ligne.Cells(10), ligne.Cells(3), ligne.Cells(24))
  3. acopier.Copy Destination:=cible
  4. Set cible = cible.Offset(1)
  5. .....


Il ne respecte pas les colonnes: il me sort 3 5 10 24 :pt1cable: 
la parade est de changer le nom de la colonne en haut... mais bon je capte pas pourquoi il fait ça.
m
0
l
Contenus similaires
1 Mars 2012 15:59:17

Ohlala, je m'absente 6 jours et voilà !

Pour concaténer deux chaînes de caractères en VB, c'est facile. Il faut utiliser l'opérateur &.
  1. Var1 = "34"
  2. Var2 = "6"
  3. MyNumber = Var1 & Var2

(Ça marche aussi "en formule")

-------

Pour ton autre question, naturellement VB remets tes colonnes dans l'ordre. Ça peut être agaçant.
Il fait le faire autrement. Logiquement :
  1. Dim col_num As Integer
  2. For Each col_num In Array(5, 10, 3, 24)
  3. ligne.Cells(col_num).Copy Destination:=cible
  4. Set cible = cible.Offset(0, 1)
  5. Next
  6. Set cible = cible.Offset(1, -4)

Dans ce cas là, on peut passer par autre chose qu'un Copy()
  1. Dim col_num As Integer
  2. For Each col_num In Array(5, 10, 3, 24)
  3. cible.Value = ligne.Cells(col_num).Value
  4. Set cible = cible.Offset(0, 1)
  5. Next
  6. Set cible = cible.Offset(1, -4)
m
0
l
1 Mars 2012 16:32:04

salut Zeb!

Et bien oui, comme quoi, tu n'es pas là et tout le monde fait des bêtises!! :D 

pendant ces 6 jours j'ai "compris" comment implémenter ta fonction zunion, mon "nouveau prog" ressemble maintenant à ça:
  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
  17.  
  18.  
  19. Sub Macro_recrutement()
  20. '
  21. ' // Préparation
  22.  
  23. Dim f_re As Worksheet ' // Feuille recrutement
  24. Dim f_dest As Worksheet ' // Feuille destination
  25. Dim f_dest1 As Worksheet ' // Feuille destination
  26.  
  27.  
  28. Set f_re = Worksheets("Recrutement")
  29. Set f_dest = Worksheets("Formation du recruté ")
  30. Set f_dest1 = Worksheets("Sites utilisés et nbre candid")
  31. Set f_dest2 = Worksheets("Feuil1")
  32.  
  33.  
  34.  
  35. f_dest.Rows("5:60").Delete ' //Je sais que ce n'est pas propre mais je n'arrive pas à le faire par le code...
  36. f_dest1.Rows("4:60").Delete
  37. f_dest2.Rows("1:60").Delete
  38.  
  39. Dim cible As Range
  40. Set cible = f_dest.Range("A5")
  41. Dim cible1 As Range
  42. Set cible1 = f_dest1.Range("A4")
  43. Dim cible2 As Range
  44. Set cible2 = f_dest2.Range("E4")
  45. Dim ligne As Range
  46. Dim acopier As Range
  47. Dim last As Range
  48. Dim concat
  49.  
  50. For Each ligne In f_re.Rows("6:60")
  51.  
  52. If ligne.Cells(35).Value Like "RETENU" Then
  53. Set acopier = Nothing
  54. For Each i In Array(5, 3, 29, 36)
  55. Set acopier = zUnion(acopier, ligne.Cells(i))
  56. Next
  57. acopier.Copy Destination:=cible
  58. Set cible = cible.Offset(1)
  59.  
  60. End If
  61.  
  62. With f_dest.Rows("5:60")
  63. .Borders(xlDiagonalDown).LineStyle = xlNone 'il faut mettre xlCOntinuous pour faire un trait
  64. .Borders(xlDiagonalUp).LineStyle = xlNone
  65. .Borders(xlEdgeLeft).LineStyle = xlNone
  66. .Borders(xlEdgeTop).LineStyle = xlNone
  67. .Borders(xlEdgeBottom).LineStyle = xlNone
  68. .Borders(xlEdgeRight).LineStyle = xlNone
  69. .Borders(xlInsideVertical).LineStyle = xlNone
  70. .Borders(xlInsideHorizontal).LineStyle = xlNone
  71. .Interior.ColorIndex = xlNone
  72. .Font.Bold = False
  73. .Font.Color = vbBlack
  74. End With
  75. Next
  76.  
  77. For Each ligne In f_re.Rows("6:60")
  78.  
  79. If ligne.Cells(24).Value <> "" Then
  80. Set acopier = Nothing
  81. For Each i In Array(5, 3, 10, 24)
  82. Set acopier = zUnion(acopier, ligne.Cells(i))
  83. Next
  84. acopier.Copy Destination:=cible1
  85. Set cible1 = cible1.Offset(1)
  86.  
  87. End If
  88.  
  89. With f_dest1.Rows("4:60")
  90. .Borders(xlDiagonalDown).LineStyle = xlNone 'il faut mettre xlCOntinuous pour faire un trait
  91. .Borders(xlDiagonalUp).LineStyle = xlNone
  92. .Borders(xlEdgeLeft).LineStyle = xlNone
  93. .Borders(xlEdgeTop).LineStyle = xlNone
  94. .Borders(xlEdgeBottom).LineStyle = xlNone
  95. .Borders(xlEdgeRight).LineStyle = xlNone
  96. .Borders(xlInsideVertical).LineStyle = xlNone
  97. .Borders(xlInsideHorizontal).LineStyle = xlNone
  98. .Interior.ColorIndex = xlNone
  99. .Font.Bold = False
  100. .Font.Color = vbBlack
  101. End With
  102. Next
  103.  
  104. For Each ligne In f_re.Rows("6:60")
  105.  
  106. If ligne.Cells(12).Value <> "" Then
  107. Set acopier = Nothing
  108. For Each i In Array(12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22)
  109. Set acopier = zUnion(acopier, ligne.Cells(i))
  110. Next
  111. acopier.Copy Destination:=cible2
  112. Set cible2 = cible2.Offset(1)
  113.  
  114. End If
  115. Next
  116.  
  117.  
  118. Sheets("Feuil1").Select
  119. Range("A1").Select
  120.  
  121. End Sub


je vais regarder pour remettre les valeurs dans l'ordre, et je reviens!! :p 


En tout cas merci pour l'aide!
m
0
l
2 Mars 2012 15:11:37

Salut Zeb! ( et les autres si il y a... :p )

Bon alors j'ai fait du ménage dans le code grâce à ce que tu m'as donné (j'ai retiré la fonction zUnion())!! et ça marche nikel ( merci donc!)!!

par contre je capte pas un truc..
dans le code:
  1. Dim com_num As Integer
  2. For Each col_num In Array(5, 10, 3, 24)
  3. cible.Value = ligne.Cells(col_num).Value
  4. Set cible = cible.Offset(0, 1)
  5. Next
  6. Set cible = cible.Offset(1, -4)


A quoi sert Dim com_num As Integer?? si il n'est pas dans le code, le code tourne qd meme... (en plus dans la boucle c'est col_num et non com_num...)


je cherche toujours à implémenter la concaténation.. j'arrive à extraire les colonnes ou il a des valeurs mais pas a faire la concaténation:
Si dans la lignes(i) des colonnes 12 13 14 15 16 17 18 19 20 21 22 il y a <>""
alors concatener dans cellule cible le texte de 12(5) & 13(5) & 14(5)...... 22(5)
ex: si dans la colonnes 12 15 19 20 il ya 1 (ou qqch..), alors dans la cellule cible écrire site 1 / site 4 / site 8 /site 9 (=CONCATENER(12(5) & 15(5) & 19(5) & 20(5) )

voila le nouveau code:
  1. Sub Macro_recrutement()
  2. '
  3. ' // Préparation
  4.  
  5. Dim f_re As Worksheet ' // Feuille recrutement
  6. Dim f_dest As Worksheet ' // Feuille destination
  7. Dim f_dest1 As Worksheet ' // Feuille destination
  8.  
  9.  
  10. Set f_re = Worksheets("Recrutement")
  11. Set f_dest = Worksheets("Formation du recruté ")
  12. Set f_dest1 = Worksheets("Sites utilisés et nbre candid")
  13. Set f_dest2 = Worksheets("Feuil1")
  14.  
  15.  
  16.  
  17. f_dest.Rows("5:60").Delete ' //Je sais que ce n'est pas propre mais je n'arrive pas à le faire par le code...
  18. f_dest1.Rows("4:60").Delete
  19. f_dest2.Rows("1:60").Delete
  20.  
  21. Dim cible As Range
  22. Set cible = f_dest.Range("A5")
  23. Dim cible1 As Range
  24. Set cible1 = f_dest1.Range("A4")
  25. Dim cible2 As Range
  26. Set cible2 = f_dest2.Range("E4")
  27. Dim ligne As Range
  28. Dim com_num As Integer 'com_num dans les For en dessous c'est col_num??
  29.  
  30.  
  31. For Each ligne In f_re.Rows("6:60")
  32.  
  33. If ligne.Cells(35).Value Like "RETENU" Then
  34. For Each col_num In Array(5, 3, 36, 29)
  35. ligne.Cells(col_num).Copy Destination:=cible
  36. Set cible = cible.Offset(0, 1)
  37. Next
  38. Set cible = cible.Offset(1, -4)
  39.  
  40. End If
  41.  
  42. With f_dest.Rows("5:60")
  43. ' Cells.Borders.LineStyle = xlNone 'ca ne marche pas... ?
  44. .Font.Bold = False
  45. .Font.Color = vbBlack
  46. End With
  47. Next
  48.  
  49. For Each ligne In f_re.Rows("6:60")
  50.  
  51. If ligne.Cells(24).Value <> "" Then
  52. For Each col_num In Array(5, 3, 10, 24)
  53. ligne.Cells(col_num).Copy Destination:=cible1
  54. Set cible1 = cible1.Offset(0, 1)
  55. Next
  56. Set cible1 = cible1.Offset(1, -4)
  57. End If
  58.  
  59. With f_dest1.Rows("4:60")
  60. 'Cells.Borders.LineStyle = xlNone 'ca ne marche pas... ?
  61. .Font.Bold = False
  62. .Font.Color = vbBlack
  63. End With
  64. Next
  65.  
  66. Sheets("Formation du recruté ").Select
  67. Range("A1").Select
  68.  
  69. End Sub


je continue à chercher pour la concaténation.
m
0
l
6 Mars 2012 14:44:38

Citation :
A quoi sert Dim com_num As Integer?? si il n'est pas dans le code, le code tourne qd meme... (en plus dans la boucle c'est col_num et non com_num...)

Nan nan. C'est bien col_num :kaola:  .... :sarcastic: 

Bon, pour me venger... N'utilises-tu pas l'Option Explicit ?
(Se renseigner sur Option Explicit)
Si la réponse est "non", j'arrête de te répondre :kaola: 
Si la réponse est "oui", je ne comprends plus ta question. :heink: 
Si la réponse est "à partir de maintenant je vais le faire", alors ta question bête aura été d'une grande utilité :o 

(Ligne 60, il manque le point devant Cells.)

Mets un peu de couleurs dans ton code en mettant =VB dans ta balise [code] : [code=VB]
m
0
l
6 Mars 2012 16:34:10

zeb a dit :
Citation :
A quoi sert Dim com_num As Integer?? si il n'est pas dans le code, le code tourne qd meme... (en plus dans la boucle c'est col_num et non com_num...)

Nan nan. C'est bien col_num :kaola:  .... :sarcastic: 

Bon, pour me venger... N'utilises-tu pas l'Option Explicit ?
(Se renseigner sur Option Explicit)
Si la réponse est "non", j'arrête de te répondre :kaola: 
Si la réponse est "oui", je ne comprends plus ta question. :heink: 
Si la réponse est "à partir de maintenant je vais le faire", alors ta question bête aura été d'une grande utilité :o 

(Ligne 60, il manque le point devant Cells.)

Mets un peu de couleurs dans ton code en mettant =VB dans ta balise [code] : [code=VB]


Hmmm alors je comprends plus....
j'ai bien compris que l'option explicit est là pour imposer la déclaration explicite de toutes les variables, mais dans les exemples que tu m'as (si gentiment :) ) donné, quand je mets Option Explicit au début du module ça plante la macro avec un vilain message "erreur de compilation : variable non définie" (cf PJ)
----------------------------------------------------
si je mets col_num as integer et dan la boucle j'ai ce message:

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

Pour le . devant Cells ligne 60, ca marche impec!! merci :bounce: 

Je vais chercher un peu plus dans l'aide avant de reposer une question bête! :D 

m
0
l
6 Mars 2012 17:50:42

Re,

pour ma concaténation je pensais à un truc du genre:

  1. Dim concat As Range
  2. Dim Var1 As Range
  3. Dim Var2 As Range
  4. .
  5. .
  6. .
  7. Set Var1 = f_re.Range("L5")
  8. Set Var2 = f_re.Range("M5")
  9. .
  10. .
  11. .
  12. Set Var9 = f_re.Range("V5")
  13.  
  14.  
  15. For Each ligne In f_re.Rows("6:60")
  16. If ligne.Cells(12).Value <> "" Then
  17. Set concat = Var1 & Var2
  18. concat.Copy Destination:=cible2
  19. Set cible2 = cible2.Offset(1)
  20. End If
  21. Next


Bon et comme je m'y attendais, ça ne marche pas ...:pt1cable: 

même avec
  1. Var1 = 5
  2. Var2 = 6


je vais finir en chine si je continue à creuser comme ça :lol: 
m
0
l
7 Mars 2012 12:02:30

Je ne comprends rien à ce que tu veux faire !
Et qu'est-ce que cette histoire de concaténation ?

Explique avec des mots simples, en français, sans utiliser un seul terme Excel ou VB, ce que tu cherches à faire.

Exemple :
Pour une ligne de ma zone, si la 12-ème case est renseignée, alors mettre la valeur des cases 12 et 13 dans une autre feuille.
Si c'est effectivement ce que tu cherches à faire, alors cela s'écrit :

  1. For Each ligne In f_re.Rows(...)
  2. If ligne.Cells(12).Value <> "" Then
  3. Union(ligne.Cells(12), ligne.Cells(13)).Copy Destination:=cible2
  4. Set cible2 = cible2.Offset(1)
  5. End If
  6. Next


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

La concaténation (du latin cum et catena) est l'art d'abouter deux chaînes.
Dans ton exemple, Var1 et Var2 sont des plages de cellules (Range). Donc rien à voir avec des chaînes.

En mathématique, on utilise différentes notions et donc différents signes pour "adjoindre" deux éléments :

  • addition pour l'arithmétique : +
  • union pour la théorie des ensembles : ∪
  • conjonction OU pour la logique : ∨
  • etc.


  • En programmation, c'est pareil, sauf qu'en fonction des langages de programmation, la méthode différente.

    En C++, c'est génial, on peut définir les opérateurs. "+" peut donc être utilisé pour toutes les notions de jonctions (sauf qu'on on se garde de mélanger arithmétique et logique).

    En VB, c'est moins souple. La concaténation, c'est "&" ou "+" (ça commence :sarcastic:  ). L'addition, c'est "+". L'union, c'est Union().

    Faut juste pas mélanger les notions ;) 
    m
    0
    l
    7 Mars 2012 13:03:55

    Re salut Zeb,

    effectivement je me suis peut etre mal exprimé... :/ 

    Si dans les lignes des colonnes de 12 à 22 ( à partir de la ligne 6) des valeurs sont renseignées, alors copier le nom des colonnes dans la case cible ( ici en l'occurance cible2) . En gros si il y a des valeurs dans les lignes i des colonnes 12 à 22, recopier les valeurs de la ligne 5
    J'ai fait un petit screenshoot de mon tableau source (a gauche ) et de mon résultat souhaité (a droite donc..):


    j’espère avoir été un peu plus clair.... :sarcastic: 
    m
    0
    l
    a b L Programmation
    7 Mars 2012 13:46:29

    Médite la dessus:

    1. Option Explicit
    2. Sub tralala()
    3. Dim firstCol As Integer
    4. Dim LastCol As Integer
    5. Dim firstRow As Integer
    6. Dim LastRow As Integer
    7. Dim ConcatCol As Integer
    8. Dim TitleRow As Integer
    9. Dim i, j As Integer
    10.  
    11.  
    12. firstCol = 1
    13. LastCol = 5
    14. firstRow = 2
    15. LastRow = 6
    16. ConcatCol = 7
    17. TitleRow = 1
    18.  
    19. For j = firstRow To LastRow
    20. Cells(j, ConcatCol).Value = ""
    21. For i = firstCol To LastCol
    22.  
    23. If Cells(j, i).Value <> "" Then
    24.  
    25. If Cells(j, ConcatCol).Value <> "" Then
    26. Cells(j, ConcatCol).Value = Cells(j, ConcatCol).Value & " / " & Cells(TitleRow, i).Value
    27. Else
    28. Cells(j, ConcatCol).Value = Cells(TitleRow, i).Value
    29. End If
    30. End If
    31. Next
    32. Next
    33. End Sub


    EDIT: J'ai fais ça vite, il y a surement moyen de faire plus propre :) 
    m
    0
    l
    7 Mars 2012 16:02:52

    Désolé tithom, je suis derrière un pare-feu qui me cache tes images :/ 

    Bon, sinon ton français plus clair que ton VB est.

    Sinon, ton problème est facile à résoudre.

    On se place sur la derrière ligne de ton tableau, dans telle colonne.
    Et on remonte jusqu'à la dernière ligne non vide. Si cette ligne est la numéro 5, c'est que celle colonne est vide !
    Et on boucle.

    Quelle est la taille de ton tableau ?
    "De la ligne 5 à la dernière ligne de la feuille Excel" est une réponse acceptable.

    Pourquoi remonter ?
    Parce que Excel met une telle fonction à notre disposition. C'est la fonction End() avec le paramètre xlUp.

    A titre d'exercice facultatif, répondre à la question "pourquoi ne pas tester en descendant (fonction End(xlDown)) ?"
    m
    0
    l
    7 Mars 2012 16:24:54

    peut être qu'avec une image mon français mieux être... :D  (qu'il est difficile d'expliquer un truc qui est clair pour moi... :pfff: )

    http://www.servimg.com/image_preview.php?i=158&u=112073...

    Il faut que la partie du code "concaténation" tourne avec une partie du code qui se trouve entre la ligne 54 et 60...
    les valeurs "concaténées" devront se trouver dans la colonne 5 ( ou E si on parle en colonne...)


    ma dernière version du code ( en couleur!! ;)  )

    1. Option Explicit
    2. Sub Macro_recrutement()
    3. '
    4. ' // Préparation
    5.  
    6. Dim f_re As Worksheet ' // Feuille recrutement
    7. Dim f_dest As Worksheet ' // Feuille destination
    8. Dim f_dest1 As Worksheet ' // Feuille destination
    9. Dim f_dest2 As Worksheet ' // Feuille destination
    10.  
    11. Set f_re = Worksheets("Recrutement")
    12. Set f_dest = Worksheets("Formation du recruté ")
    13. Set f_dest1 = Worksheets("Sites utilisés et nbre candid")
    14. Set f_dest2 = Worksheets("Feuil1")
    15.  
    16. 'Application.ScreenUpdating = False
    17.  
    18. f_dest.Rows("5:60").Delete
    19. f_dest1.Rows("4:60").Delete
    20. f_dest2.Rows("1:60").Delete
    21.  
    22. Dim cible As Range
    23. Set cible = f_dest.Range("A5")
    24. Dim cible1 As Range
    25. Set cible1 = f_dest1.Range("A4")
    26. Dim cible2 As Range
    27. Set cible2 = f_dest2.Range("E4")
    28. Dim ligne As Range
    29. Dim col_num As Variant
    30.  
    31.  
    32.  
    33.  
    34. For Each ligne In f_re.Rows("6:60")
    35.  
    36. If ligne.Cells(35).Value Like "RETENU" Then 'Si on a RETENU dans la colonne AI alors
    37. For Each col_num In Array(5, 3, 36, 29) ' on colle les valeurs des colonne 5 3 36 29
    38. ligne.Cells(col_num).Copy Destination:=cible
    39. Set cible = cible.Offset(0, 1)
    40. Next
    41. Set cible = cible.Offset(1, -4)
    42.  
    43. End If
    44.  
    45. With f_dest.Rows("5:60")
    46. .Cells.Borders.LineStyle = xlNone 'plus de ligne dans les cellules
    47. .Font.Bold = False 'plus de gras sur la police
    48. .Font.Color = vbBlack 'couleur de police = noir
    49. .Interior.ColorIndex = xlNone 'plus de couleur de fond
    50. End With
    51. Next
    52.  
    53. For Each ligne In f_re.Rows("6:60")
    54.  
    55. If ligne.Cells(24).Value <> "" Then 'Si on a qqch ds la colonne X alors
    56. For Each col_num In Array(5, 3, 10, 24) ' on colle les valeurs des colonne 5 3 10 24
    57. ligne.Cells(col_num).Copy Destination:=cible1
    58. Set cible1 = cible1.Offset(0, 1)
    59. Next
    60. Set cible1 = cible1.Offset(1, -4)
    61. End If
    62.  
    63. With f_dest1.Rows("4:60")
    64. .Cells.Borders.LineStyle = xlNone
    65. .Font.Bold = False
    66. .Font.Color = vbBlack
    67. .Interior.ColorIndex = xlNone
    68. End With
    69. Next
    70.  
    71.  
    72. For Each ligne In f_re.Rows("6:60")
    73. If ligne.Cells(12).Value <> "" Then
    74. Union(ligne.Cells(12), ligne.Cells(13), ligne.Cells(14), ligne.Cells(15), ligne.Cells(16), ligne.Cells(17), ligne.Cells(18), ligne.Cells(19)).Copy Destination:=cible2
    75. Set cible2 = cible2.Offset(1)
    76. End If
    77. Next
    78.  
    79. Sheets("Formation du recruté ").Select
    80. Range("A1").Select
    81.  
    82. 'Application.ScreenUpdating = True
    83.  
    84. End Sub



    pour mon problème de col_num j'ai mis en variant et la miracle ca fonctionne!

    je vais étudier le' code de drul également
    m
    0
    l
    7 Mars 2012 17:03:16

    Ouh que tu es vilain !!!

    Sais-tu que tu vas mettre en forme tes zones de réception une centaine de fois au lieu d'une fois chacune ?

    (Sors des boucles le code qui n'a rien à y faire !!!!!)
    [:zeb:4]

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

    Citation :
    pour mon problème de col_num j'ai mis en variant et la miracle ca fonctionne!

    argggggggggggggh x_X

    mea culpa, mea maxima culpa.
    Je le sais pourtant. Je me fais avoir tout le temps.
    Array() ne renvoie pas d'entier :pfff: 

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

    Citation :
    je vais étudier le' code de drul également

    Tu fais bien.
    m
    0
    l
    7 Mars 2012 17:30:16

    rrhhooo effectivement le vilain que je suis!! faut bien faire travailler nos machines super puissantes !! :pt1cable: 


    ----------------------------------------------------------------
    Non mais en plus dans le sujet sur lequel je me suis appuyé, ya le même problème!! Il fallait lire jusqu'au bout... Non mais au moins j'ai appris qqch!! :) 

    du coup le nouveau nouveau code:

    1. Option Explicit
    2. Sub Macro_recrutement()
    3. '
    4. ' // Préparation
    5.  
    6. Dim f_re As Worksheet ' // Feuille recrutement
    7. Dim f_dest As Worksheet ' // Feuille destination
    8. Dim f_dest1 As Worksheet ' // Feuille destination
    9. Dim f_dest2 As Worksheet ' // Feuille destination
    10. Dim feuille As Variant
    11.  
    12.  
    13. Set f_re = Worksheets("Recrutement")
    14. Set f_dest = Worksheets("Formation du recruté ")
    15. Set f_dest1 = Worksheets("Sites utilisés et nbre candid")
    16. Set f_dest2 = Worksheets("Feuil1")
    17.  
    18. 'Application.ScreenUpdating = False
    19.  
    20. f_dest.Rows("5:60").Delete ' //Je sais que ce n'est pas propre mais je n'arrive pas à le faire par le code...
    21. f_dest1.Rows("5:60").Delete
    22. f_dest2.Rows("1:60").Delete
    23.  
    24. Dim cible As Range
    25. Set cible = f_dest.Range("A5")
    26. Dim cible1 As Range
    27. Set cible1 = f_dest1.Range("A5")
    28. Dim cible2 As Range
    29. Set cible2 = f_dest2.Range("E5")
    30. Dim ligne As Range
    31. Dim col_num As Variant 'com_num dans les For en dessous c'est col_num??
    32.  
    33.  
    34. For Each ligne In f_re.Rows("6:60")
    35.  
    36. If ligne.Cells(35).Value Like "RETENU" Then
    37. For Each col_num In Array(5, 3, 36, 29)
    38. ligne.Cells(col_num).Copy Destination:=cible
    39. Set cible = cible.Offset(0, 1)
    40. Next
    41. Set cible = cible.Offset(1, -4)
    42.  
    43. End If
    44.  
    45. Next
    46.  
    47. For Each ligne In f_re.Rows("6:60")
    48.  
    49. If ligne.Cells(24).Value <> "" Then
    50. For Each col_num In Array(5, 3, 10, 24)
    51. ligne.Cells(col_num).Copy Destination:=cible1
    52. Set cible1 = cible1.Offset(0, 1)
    53. Next
    54. Set cible1 = cible1.Offset(1, -4)
    55. End If
    56. Next
    57.  
    58.  
    59. For Each ligne In f_re.Rows("6:60")
    60. If ligne.Cells(12).Value <> "" Then
    61. Union(ligne.Cells(12), ligne.Cells(13), ligne.Cells(14), ligne.Cells(15), ligne.Cells(16), ligne.Cells(17), ligne.Cells(18), ligne.Cells(19)).Copy Destination:=cible2
    62. Set cible2 = cible2.Offset(1)
    63. End If
    64. Next
    65.  
    66.  
    67. For Each feuille In Array(f_dest, f_dest1, f_dest2)
    68. With feuille.Rows("5:60")
    69. .Cells.Borders.LineStyle = xlNone
    70. .Font.Bold = False
    71. .Font.Color = vbBlack
    72. .Interior.ColorIndex = xlNone
    73. End With
    74. Next
    75.  
    76.  
    77. Sheets("Formation du recruté ").Select
    78. Range("A1").Select
    79.  
    80. 'Application.ScreenUpdating = True
    81.  
    82. End Sub


    m
    0
    l
    8 Mars 2012 17:18:34

    zeb a dit :
    Alors, tu y arrives à intégrer ce que je te propose là : http://www.presence-pc.com/forum/id-2112689/extraire-do...
    ?



    YES!!! :D  j'ai meme intégré le code de drul ( un GRAND merci à drul d'ailleurs!!!! ;)  ) et le tout fonctionne!!!! :p 


    J'ai un peu rusé pour la concaténation: (oui oui je sais spa bien... mais bon je débute en VBA... )
    - 1 je concatene sur une colonne vide de ma page f_re (AM) (ligne 54 à 68)
    - 2 je copie les données avec ma routine pour la destination en intégrant la colonne AM (ligne 88 à 97)
    - 3 je supprime la colonne AM (113 à 114)
    donc voici la dernière version du code: elle fonctionne MAIS elle peut être encore améliorée!!


    1. Option Explicit
    2. Sub Macro_recrutement()
    3. '
    4. ' // définition des variables
    5.  
    6. Dim f_re As Worksheet ' // Feuille recrutement
    7. Dim f_dest As Worksheet ' // Feuille destination
    8. Dim f_dest1 As Worksheet ' // Feuille destination
    9. Dim f_dest2 As Worksheet ' // Feuille destination
    10. Dim cible As Range
    11. Dim cible1 As Range
    12. Dim cible2 As Range
    13. Dim ligne As Range
    14. Dim feuille As Variant
    15. Dim firstCol As Integer
    16. Dim LastCol As Integer
    17. Dim firstRow As Integer
    18. Dim LastRow As Integer
    19. Dim ConcatCol As Integer
    20. Dim TitleRow As Integer
    21. Dim i, j As Integer
    22. Dim col_num As Variant
    23. Dim LastLine As Long
    24.  
    25. ' paramétrage des variables
    26. Set f_re = Worksheets("Recrutement")
    27. Set f_dest = Worksheets("Formation du recruté ")
    28. Set f_dest1 = Worksheets("Sites utilisés et nbre candid")
    29. Set f_dest2 = Worksheets("Feuil1")
    30. firstCol = 12
    31. LastCol = 22
    32. firstRow = 6
    33. LastRow = 60
    34. ConcatCol = 39
    35. TitleRow = 5
    36.  
    37. 'ou se trouve la derniere ligne?
    38. LastLine = f_re.Range("X65536").End(xlUp).Row
    39. LastLine = LastLine + 15
    40.  
    41. 'on efface les données des feuilles cible à partir de la ligne 4 jusq'a 100 ( pour le moment)
    42. f_dest.Rows("4:" & LastLine).Delete '
    43. f_dest1.Rows("4:" & LastLine).Delete
    44. f_dest2.Rows("1:" & LastLine).Delete
    45.  
    46. 'définition des cellules cibles
    47. Set cible = f_dest.Range("A4")
    48. Set cible1 = f_dest1.Range("A4")
    49. Set cible2 = f_dest2.Range("E5")
    50.  
    51.  
    52. 'concaténation sur la colonne AM de f_re les titres des cellules de la colonne L à V si des valeurs y figurent
    53.  
    54. Worksheets("Recrutement").Select
    55. For j = firstRow To LastRow
    56. Cells(j, ConcatCol).Value = ""
    57. For i = firstCol To LastCol
    58.  
    59. If Cells(j, i).Value <> "" Then
    60.  
    61. If Cells(j, ConcatCol).Value <> "" Then
    62. Cells(j, ConcatCol).Value = Cells(j, ConcatCol).Value & " / " & Cells(TitleRow, i).Value
    63. Else
    64. Cells(j, ConcatCol).Value = Cells(TitleRow, i).Value
    65. End If
    66. End If
    67. Next
    68. Next
    69.  
    70. 'Si RETENU dans colonne AI (35) alors copier colonne 5 3 36 29
    71.  
    72. For Each ligne In f_re.Rows("6:" & LastLine)
    73.  
    74. If ligne.Cells(35).Value Like "RETENU" Then
    75. For Each col_num In Array(5, 3, 36, 29)
    76. ligne.Cells(col_num).Copy Destination:=cible
    77. Set cible = cible.Offset(0, 1)
    78. Next
    79. Set cible = cible.Offset(1, -4)
    80.  
    81. End If
    82.  
    83. Next
    84.  
    85. 'Si qqch dans colonne x (24) alors copier colonne 5 3 10 24 39 (39 étant la concaténation préparé en amont.)
    86.  
    87.  
    88. For Each ligne In f_re.Rows("6:" & LastLine)
    89.  
    90. If ligne.Cells(24).Value <> "" Then
    91. For Each col_num In Array(5, 3, 10, 24, 39)
    92. ligne.Cells(col_num).Copy Destination:=cible1
    93. Set cible1 = cible1.Offset(0, 1)
    94. Next
    95. Set cible1 = cible1.Offset(1, -5)
    96. End If
    97. Next
    98.  
    99.  
    100. 'nettoyage des feuilles dest (plus de lignes, plus de couleur, pas de gras..)
    101.  
    102. For Each feuille In Array(f_dest, f_dest1, f_dest2)
    103. With feuille.Rows("4:" & LastLine)
    104. .Cells.Borders.LineStyle = xlNone
    105. .Font.Bold = False
    106. .Font.Color = vbBlack
    107. .Interior.ColorIndex = xlNone
    108. End With
    109. Next
    110.  
    111.  
    112. 'suppression de la colonne qui permet la concaténation
    113. Worksheets("Recrutement").Select
    114. Columns("AM:AM").Delete Shift:=xlToLeft
    115.  
    116. 'affichage de la page formation recruté
    117. Sheets("Formation du recruté ").Select
    118. Range("A1").Select
    119. MsgBox "La dernière ligne non vide de la colonne A est la ligne " & LastLine
    120.  
    121. End Sub


    si vous avez des remarques ( ce dont je ne doute pas.... :pt1cable:  )
    m
    0
    l
    8 Mars 2012 17:27:01

    Une autre question, si ma macro est exécuté avec d'autre fichier, la du coup si on lance la macro (via CTRL + W) alors que l'on se trouve sur un autre fichier... et pouf ca marche pas :/  .

    ma question est: (je n'ai pas encore regardé sur le net la faisabilité ceci dit.....)
    peut-on lui dire de faire la macro sur les classeurs dont le début est Trame suivi (la fin du fichier change en fonction de la date de MAJ...)
    1. Dim f_re As Worksheet
    2.  
    3. Set f_re = Workbook("Trame suivi *").Worksheets("Recrutement")


    Merci d'avance.
    m
    0
    l

    Meilleure solution

    9 Mars 2012 11:32:25

    Pas mal !

    Cependant, quelques petites erreurs, quelques points de détails, juste pour chipoter :sol: 

    Ligne 39 :
    1. LastLine = LastLine + 15

    Et si LastLine vaut 65522 ou plus ? :o 
    Improbable ne veut pas dire impossible !
    1. LastLine = Min(LastLine + 15, 65536)

    [:glublutz:25]

    Sauf que VB ne connaît pas la fonction Min() ... :pfff: 
    1. LastLine = WorksheetFunction.Min(LastLine + 15, 65536)


    Et si ta feuille fait plus de 65536 lignes ?
    Si, si c'est possible avec les dernières versions d'Excel !

    1. LastLine = WorksheetFunction.Min(f_re.Rows.Count, f_re.Cells(f_re.Rows.Count, "X").End(xlUp).Row + 15)


    :lol: 

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

    Ligne 113
    1. Worksheets("Recrutement").Select
    2. Columns("AM:AM").Delete Shift:=xlToLeft

    Nooom de Zeus !!!! Marty, vire-moi ce Select, accroche la colonne à sa feuille et arrête de bégayer.
    1. Worksheets("Recrutement").Columns("AM").Delete Shift:=xlToLeft


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

    Ligne 119
    Quel message tout pourri ! :o  :o  :o 
    Fais un Select sur la colonne A, ligne LastLine (*)

    ________
    (*) Arggggh. zeb vient de proposer un Select !!!!

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

    Ah tu veux jouer avec les classeurs maintenant !
    Alors il va falloir préciser pour chaque feuille de quel classeur on parle.
    L'utilisation à bon escient de ThisWorkbook est vivement conseillée.

    La collection des classeurs est au pluriel.
    Workbooks("Trame suivi *").

    Sinon, pour parcourir les classeurs, c'est comme d'hab' :

    1. Dim wb As Workbook
    2. For Each wb In Workbooks
    3.  
    4. If wb Is ThisWorkbook Then
    5. ' On fait quoi si on est dans le classeur qui contient la macro ?
    6. End If
    7.  
    8. MsgBox "Je suis le classeur " & wb.Name
    9.  
    10. Next
    partage
    9 Mars 2012 13:01:37

    Tu es en droit de chipoter!!! :lol: 

    ---------------------------------
    Lastline

    je fais mon lastline sur la colonne X, par contre le traitement pour la feuille f_dest1 (ligne 88 à 97) utilise une autre colonne qui peut descendre plus bas que la colonne de lastline (colonne AA et AC), MAIS pas a tous les coups... :pt1cable: 
    Si je fais lastline sur la colonne AA ou AC je pourrais ds ce cas la ne pas voir les lignes sI AA et AC se termine avant X... (encore une fois je ne pense pas avoir été clair...)
    En tout cas en faisant + 15, je suis sur d'etre dedans.... et puis 15 lignes en plus à traiter spa grd chose!! ;) 

    ---------------------------
    Merci pour l'astuce en L113

    je ferais la modif.

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

    les lignes 115 à 199 n'existent plus!! :kaola:  c'etait juste pour avoir l'info de Lastline!!
    ----------------------------

    Ca ma l'air bien complex.... je regarderai qd même !! pour le moment ca marche pas trop mal!!
    ----------------------------
    ----------------------------

    En tous cas un grand merci a toi Zeb et à drul sans qui je n'aurai pas terminé ce code!! :D 
    m
    0
    l
    a b L Programmation
    9 Mars 2012 13:22:42

    Citation :
    En tous cas un grand merci a toi Zeb et à drul sans qui je n'aurai pas terminé ce code!!


    :jap: 

    EDIT: si tu es satisfait, n'hésite pas à selectionner une meilleures réponse :lol: 
    m
    0
    l
    9 Mars 2012 13:56:09

    Si tu as des colonnes qui peuvent être vides, il faut prendre le max de lignes des colonnes pertinentes.

    1. LastLine = WorksheetFunction.Max( _
    2. f_re.Cells(f_re.Rows.Count, "X" ).End(xlUp).Row,
    3. f_re.Cells(f_re.Rows.Count, "AA").End(xlUp).Row,
    4. f_re.Cells(f_re.Rows.Count, "AC").End(xlUp).Row)


    Ça me paraît clair :o 

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

    @drul : Arf? Comment faire ? Nous sommes deux et nous n'avons donné que des meilleures réponses !
    :pt1cable: 
    m
    0
    l
    a b L Programmation
    9 Mars 2012 14:00:44

    Non, moi je donne des bidouilles qui marche :pt1cable: , toi tu donnes des bonnes réponses (donc la meilleure réponse te reviens de droit :jap: )
    m
    0
    l
    9 Mars 2012 15:46:31

    /private
    Bah, entre ton pragmatisme et mon académisme, nos chers forumeurs ont une large gamme de choix.
    ;) 
    m
    0
    l
    11 Mars 2012 12:44:43

    Ralala merci Zeb, je ne savais pas qu'il était possible de définir le max de plusieurs colonnes... 'fin en même temps en prog on peut faire ce que l'on veut!! :lol:  Donc maintenant plus besoin de mon " +15 pour être large!!! D'ailleurs j'ai vu que pour le code de drul je n'avais pas définit une variable en Lastline... ça marchait beaucoup moins bien du coup.... :pt1cable: 
    En tout cas je suis tres content que mon prog fonctionne!! :D  encore un grand merci!!!


    Il va falloir que je fasse un choix entre le "pragmatisme" et "l’académicien " :??: 



    m
    0
    l
    11 Mars 2012 12:46:25

    drul a dit :
    Non, moi je donne des bidouilles qui marche :pt1cable: , toi tu donnes des bonnes réponses (donc la meilleure réponse te reviens de droit :jap: )


    peut être une bidouille, mais ça m'a permis de terminer mon code!!!

    m
    0
    l