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

T

tithom_82

Habitué
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:
Vous devez être connecté pour voir les images.

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.)

Code: 
Sub Macro_recrutement()
'
' // Préparation
 
Dim f_re As Worksheet ' // Feuille recrutement
Dim f_dest As Worksheet ' // Feuille destination
Dim f_dest1 As Worksheet ' // Feuille destination
Dim f_dest2 As Worksheet ' // Feuille destination
 
Set f_re = Worksheets("Recrutement")
Set f_dest = Worksheets("Formation du recruté ")
Set f_dest1 = Worksheets("Sites utilisés et nbre candid")
Set f_dest2 = Worksheets("Feuil1")


f_dest.Rows("5:500").Delete ' //Je sais que ce n'est pas propre mais je n'arrive pas à le faire par le code...


Dim cible As Range
Set cible = f_dest.Range("A5")
Dim cible1 As Range
Set cible1 = f_dest1.Range("A4")
Dim cible2 As Range
Set cible2 = f_dest2.Range("A4")
Dim ligne As Range
Dim acopier As Range

 

' // Début
 

   For Each ligne In f_re.Rows("6:500")
 
        If ligne.Cells(35).Value Like "RETENU" Then
            Set acopier = Union(ligne.Cells(36), ligne.Cells(29), ligne.Cells(5))
            acopier.Copy Destination:=cible
            Set cible = cible.Offset(1)
   With f_dest.Rows("5:500")
       .Borders(xlDiagonalDown).LineStyle = xlNone 'il faut mettre xlCOntinuous pour faire un trait
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       .Borders(xlEdgeBottom).LineStyle = xlNone
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideVertical).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
       .Interior.ColorIndex = xlNone
       .Font.Bold = False
       .Font.Color = vbBlack
   End With
   
    End If
 
 
        If ligne.Cells(24).Value <> "" Then
            Set acopier = Union(ligne.Cells(5), ligne.Cells(10), ligne.Cells(24))
            acopier.Copy Destination:=cible1
            Set cible1 = cible1.Offset(1)
   With f_dest1.Rows("4:500")
       .Borders(xlDiagonalDown).LineStyle = xlNone 'il faut mettre xlCOntinuous pour faire un trait
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       .Borders(xlEdgeBottom).LineStyle = xlNone
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideVertical).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
       .Interior.ColorIndex = xlNone
       .Font.Bold = False
       .Font.Color = vbBlack
   End With
   
    End If
    
 Next
 
Sheets("Feuil1").Select
Range("A1").Select

 
End Sub




Merci beaucoup pour votre aide!!

Guillaume
 
T

tithom_82

Habitué
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?

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

dans l'aide Exel je trouve ca:
Code: 
Var1 = "34": Var2 = "6"    ' Initialise les variables contenant des chaînes.
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:
 
T

tithom_82

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

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.
 
zeb

zeb

Modérateur
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 &.
Code: 
Var1 = "34"
Var2 = "6"
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 :
Code: 
Dim col_num As Integer
For Each col_num In Array(5, 10, 3, 24)
    ligne.Cells(col_num).Copy Destination:=cible
    Set cible = cible.Offset(0, 1)
Next
Set cible = cible.Offset(1, -4)
Dans ce cas là, on peut passer par autre chose qu'un Copy()
Code: 
Dim col_num As Integer
For Each col_num In Array(5, 10, 3, 24)
    cible.Value = ligne.Cells(col_num).Value
    Set cible = cible.Offset(0, 1)
Next
Set cible = cible.Offset(1, -4)
 
T

tithom_82

Habitué
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:
Code: 
Private Function zUnion(ParamArray range1()) As Range
    Dim result As Range
    Dim r      As Variant
 
    For Each r In range1
        If Not r Is Nothing Then
            If result Is Nothing Then
                Set result = r
            Else
                Set result = Union(result, r)
            End If
        End If
    Next
 
    Set zUnion = result
End Function


Sub Macro_recrutement()
'
' // Préparation

Dim f_re As Worksheet ' // Feuille recrutement
Dim f_dest As Worksheet ' // Feuille destination
Dim f_dest1 As Worksheet ' // Feuille destination

 
Set f_re = Worksheets("Recrutement")
Set f_dest = Worksheets("Formation du recruté ")
Set f_dest1 = Worksheets("Sites utilisés et nbre candid")
Set f_dest2 = Worksheets("Feuil1")

 
 
f_dest.Rows("5:60").Delete ' //Je sais que ce n'est pas propre mais je n'arrive pas à le faire par le code...
f_dest1.Rows("4:60").Delete
f_dest2.Rows("1:60").Delete
 
Dim cible As Range
Set cible = f_dest.Range("A5")
Dim cible1 As Range
Set cible1 = f_dest1.Range("A4")
Dim cible2 As Range
Set cible2 = f_dest2.Range("E4")
Dim ligne As Range
Dim acopier As Range
Dim last As Range
Dim concat
 
   For Each ligne In f_re.Rows("6:60")
 
             If ligne.Cells(35).Value Like "RETENU" Then
            Set acopier = Nothing
            For Each i In Array(5, 3, 29, 36)
                Set acopier = zUnion(acopier, ligne.Cells(i))
            Next
            acopier.Copy Destination:=cible
            Set cible = cible.Offset(1)
   
        End If
  
       With f_dest.Rows("5:60")
       .Borders(xlDiagonalDown).LineStyle = xlNone 'il faut mettre xlCOntinuous pour faire un trait
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       .Borders(xlEdgeBottom).LineStyle = xlNone
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideVertical).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
       .Interior.ColorIndex = xlNone
       .Font.Bold = False
       .Font.Color = vbBlack
   End With
   Next

   For Each ligne In f_re.Rows("6:60")
 
             If ligne.Cells(24).Value <> "" Then
            Set acopier = Nothing
            For Each i In Array(5, 3, 10, 24)
                Set acopier = zUnion(acopier, ligne.Cells(i))
            Next
            acopier.Copy Destination:=cible1
            Set cible1 = cible1.Offset(1)
   
        End If
  
       With f_dest1.Rows("4:60")
       .Borders(xlDiagonalDown).LineStyle = xlNone 'il faut mettre xlCOntinuous pour faire un trait
       .Borders(xlDiagonalUp).LineStyle = xlNone
       .Borders(xlEdgeLeft).LineStyle = xlNone
       .Borders(xlEdgeTop).LineStyle = xlNone
       .Borders(xlEdgeBottom).LineStyle = xlNone
       .Borders(xlEdgeRight).LineStyle = xlNone
       .Borders(xlInsideVertical).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
       .Interior.ColorIndex = xlNone
       .Font.Bold = False
       .Font.Color = vbBlack
   End With
   Next

 For Each ligne In f_re.Rows("6:60")
 
             If ligne.Cells(12).Value <> "" Then
                Set acopier = Nothing
            For Each i In Array(12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22)
                Set acopier = zUnion(acopier, ligne.Cells(i))
            Next
            acopier.Copy Destination:=cible2
            Set cible2 = cible2.Offset(1)
   
        End If
 Next


Sheets("Feuil1").Select
Range("A1").Select

End Sub

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


En tout cas merci pour l'aide!
 
T

tithom_82

Habitué
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:
Code: 
Dim com_num As Integer
For Each col_num In Array(5, 10, 3, 24)
    cible.Value = ligne.Cells(col_num).Value
    Set cible = cible.Offset(0, 1)
Next
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:
Code: 
Sub Macro_recrutement()
'
' // Préparation

Dim f_re As Worksheet ' // Feuille recrutement
Dim f_dest As Worksheet ' // Feuille destination
Dim f_dest1 As Worksheet ' // Feuille destination

 
Set f_re = Worksheets("Recrutement")
Set f_dest = Worksheets("Formation du recruté ")
Set f_dest1 = Worksheets("Sites utilisés et nbre candid")
Set f_dest2 = Worksheets("Feuil1")

 
 
f_dest.Rows("5:60").Delete ' //Je sais que ce n'est pas propre mais je n'arrive pas à le faire par le code...
f_dest1.Rows("4:60").Delete
f_dest2.Rows("1:60").Delete
 
Dim cible As Range
Set cible = f_dest.Range("A5")
Dim cible1 As Range
Set cible1 = f_dest1.Range("A4")
Dim cible2 As Range
Set cible2 = f_dest2.Range("E4")
Dim ligne As Range
Dim com_num As Integer   'com_num dans les For en dessous c'est col_num??


   For Each ligne In f_re.Rows("6:60")
 
             If ligne.Cells(35).Value Like "RETENU" Then
                For Each col_num In Array(5, 3, 36, 29)
                    ligne.Cells(col_num).Copy Destination:=cible
                    Set cible = cible.Offset(0, 1)
                Next
                    Set cible = cible.Offset(1, -4)
        
             End If
  
       With f_dest.Rows("5:60")
            ' Cells.Borders.LineStyle = xlNone  'ca ne marche pas... ?
             .Font.Bold = False
             .Font.Color = vbBlack
        End With
   Next

   For Each ligne In f_re.Rows("6:60")
 
             If ligne.Cells(24).Value <> "" Then
                For Each col_num In Array(5, 3, 10, 24)
                    ligne.Cells(col_num).Copy Destination:=cible1
                    Set cible1 = cible1.Offset(0, 1)
                Next
                    Set cible1 = cible1.Offset(1, -4)
             End If
  
       With f_dest1.Rows("4:60")
        'Cells.Borders.LineStyle = xlNone  'ca ne marche pas... ?
       .Font.Bold = False
       .Font.Color = vbBlack
   End With
   Next

Sheets("Formation du recruté ").Select
Range("A1").Select

End Sub

je continue à chercher pour la concaténation.
 
zeb

zeb

Modérateur
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...)
Cliquez pour agrandir...
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]
 
T

tithom_82

Habitué


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)
Vous devez être connecté pour voir les images.

----------------------------------------------------
si je mets col_num as integer et dan la boucle j'ai ce message:
Vous devez être connecté pour voir les images.

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

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

 
T

tithom_82

Habitué
Re,

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

Code: 
Dim concat As Range
Dim Var1 As Range
Dim Var2 As Range
.
.
.
Set Var1 = f_re.Range("L5")
Set Var2 = f_re.Range("M5")
.
.
.
Set Var9 = f_re.Range("V5")


For Each ligne In f_re.Rows("6:60")
    If ligne.Cells(12).Value <> "" Then
        Set concat = Var1 & Var2
        concat.Copy Destination:=cible2
        Set cible2 = cible2.Offset(1)
End If
Next

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

même avec
Code: 
Var1 = 5
Var2 = 6

je vais finir en chine si je continue à creuser comme ça :lol:
 
zeb

zeb

Modérateur
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 :

Code: 
For Each ligne In f_re.Rows(...)
    If ligne.Cells(12).Value <> "" Then
        Union(ligne.Cells(12), ligne.Cells(13)).Copy Destination:=cible2
        Set cible2 = cible2.Offset(1)
    End If
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 ;)
 
T

tithom_82

Habitué
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..):

Vous devez être connecté pour voir les images.

j’espère avoir été un peu plus clair.... :sarcastic:
 
drul

drul

Obscur pro du hardware
Staff
Médite la dessus:

Code: 
Option Explicit
Sub tralala()
    Dim firstCol As Integer
    Dim LastCol As Integer
    Dim firstRow As Integer
    Dim LastRow As Integer
    Dim ConcatCol As Integer
    Dim TitleRow As Integer
    Dim i, j As Integer

    
    firstCol = 1
    LastCol = 5
    firstRow = 2
    LastRow = 6
    ConcatCol = 7
    TitleRow = 1
    
    For j = firstRow To LastRow
        Cells(j, ConcatCol).Value = ""
        For i = firstCol To LastCol
            
            If Cells(j, i).Value <> "" Then
                
                If Cells(j, ConcatCol).Value <> "" Then
                    Cells(j, ConcatCol).Value = Cells(j, ConcatCol).Value & " / " & Cells(TitleRow, i).Value
                Else
                    Cells(j, ConcatCol).Value = Cells(TitleRow, i).Value
                End If
            End If
        Next
    Next
End Sub

EDIT: J'ai fais ça vite, il y a surement moyen de faire plus propre :)
 
zeb

zeb

Modérateur
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)) ?"
 
T

tithom_82

Habitué
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:)

Vous devez être connecté pour voir les liens.


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!! ;) )

Code: 
Option Explicit
Sub Macro_recrutement()
'
' // Préparation

Dim f_re As Worksheet ' // Feuille recrutement
Dim f_dest As Worksheet ' // Feuille destination
Dim f_dest1 As Worksheet ' // Feuille destination
Dim f_dest2 As Worksheet ' // Feuille destination
 
Set f_re = Worksheets("Recrutement")
Set f_dest = Worksheets("Formation du recruté ")
Set f_dest1 = Worksheets("Sites utilisés et nbre candid")
Set f_dest2 = Worksheets("Feuil1")

'Application.ScreenUpdating = False
 
f_dest.Rows("5:60").Delete 
f_dest1.Rows("4:60").Delete
f_dest2.Rows("1:60").Delete
 
Dim cible As Range
Set cible = f_dest.Range("A5")
Dim cible1 As Range
Set cible1 = f_dest1.Range("A4")
Dim cible2 As Range
Set cible2 = f_dest2.Range("E4")
Dim ligne As Range
Dim col_num As Variant 




   For Each ligne In f_re.Rows("6:60")
 
             If ligne.Cells(35).Value Like "RETENU" Then               'Si on a RETENU dans la colonne AI alors
                For Each col_num In Array(5, 3, 36, 29)                 ' on colle les valeurs des colonne 5 3 36 29
                    ligne.Cells(col_num).Copy Destination:=cible     
                    Set cible = cible.Offset(0, 1)
                Next
                    Set cible = cible.Offset(1, -4)
        
             End If
  
       With f_dest.Rows("5:60")
             .Cells.Borders.LineStyle = xlNone              'plus de ligne dans les cellules
             .Font.Bold = False                                     'plus de gras sur la police 
             .Font.Color = vbBlack                               'couleur de police = noir
             .Interior.ColorIndex = xlNone                    'plus de couleur de fond 
        End With
   Next

   For Each ligne In f_re.Rows("6:60")
 
             If ligne.Cells(24).Value <> "" Then                               'Si on a qqch ds la colonne X alors 
                For Each col_num In Array(5, 3, 10, 24)                     ' on colle les valeurs des colonne 5 3 10 24
                    ligne.Cells(col_num).Copy Destination:=cible1
                    Set cible1 = cible1.Offset(0, 1)
                Next
                    Set cible1 = cible1.Offset(1, -4)
             End If
  
       With f_dest1.Rows("4:60")
       .Cells.Borders.LineStyle = xlNone
       .Font.Bold = False
       .Font.Color = vbBlack
       .Interior.ColorIndex = xlNone
   End With
   Next


For Each ligne In f_re.Rows("6:60")
      If ligne.Cells(12).Value <> "" Then
        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
        Set cible2 = cible2.Offset(1) 
    End If
Next

Sheets("Formation du recruté ").Select
Range("A1").Select

'Application.ScreenUpdating = True

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
 
zeb

zeb

Modérateur
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]

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

pour mon problème de col_num j'ai mis en variant et la miracle ca fonctionne!
Cliquez pour agrandir...
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:

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

je vais étudier le' code de drul également
Cliquez pour agrandir...
Tu fais bien.
 
T

tithom_82

Habitué
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:

Code: 
Option Explicit
Sub Macro_recrutement()
'
' // Préparation

Dim f_re As Worksheet ' // Feuille recrutement
Dim f_dest As Worksheet ' // Feuille destination
Dim f_dest1 As Worksheet ' // Feuille destination
Dim f_dest2 As Worksheet ' // Feuille destination
Dim feuille As Variant


Set f_re = Worksheets("Recrutement")
Set f_dest = Worksheets("Formation du recruté ")
Set f_dest1 = Worksheets("Sites utilisés et nbre candid")
Set f_dest2 = Worksheets("Feuil1")

'Application.ScreenUpdating = False
 
f_dest.Rows("5:60").Delete ' //Je sais que ce n'est pas propre mais je n'arrive pas à le faire par le code...
f_dest1.Rows("5:60").Delete
f_dest2.Rows("1:60").Delete
 
Dim cible As Range
Set cible = f_dest.Range("A5")
Dim cible1 As Range
Set cible1 = f_dest1.Range("A5")
Dim cible2 As Range
Set cible2 = f_dest2.Range("E5")
Dim ligne As Range
Dim col_num As Variant 'com_num dans les For en dessous c'est col_num??


   For Each ligne In f_re.Rows("6:60")
 
             If ligne.Cells(35).Value Like "RETENU" Then
                For Each col_num In Array(5, 3, 36, 29)
                    ligne.Cells(col_num).Copy Destination:=cible
                    Set cible = cible.Offset(0, 1)
                Next
                    Set cible = cible.Offset(1, -4)
        
             End If
  
   Next

   For Each ligne In f_re.Rows("6:60")
 
             If ligne.Cells(24).Value <> "" Then
                For Each col_num In Array(5, 3, 10, 24)
                    ligne.Cells(col_num).Copy Destination:=cible1
                    Set cible1 = cible1.Offset(0, 1)
                Next
                    Set cible1 = cible1.Offset(1, -4)
             End If
   Next


For Each ligne In f_re.Rows("6:60")
      If ligne.Cells(12).Value <> "" Then
        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
        Set cible2 = cible2.Offset(1)
    End If
Next


For Each feuille In Array(f_dest, f_dest1, f_dest2)
   With feuille.Rows("5:60")
        .Cells.Borders.LineStyle = xlNone
        .Font.Bold = False
        .Font.Color = vbBlack
        .Interior.ColorIndex = xlNone
    End With
Next
 
    
Sheets("Formation du recruté ").Select
Range("A1").Select

'Application.ScreenUpdating = True

End Sub

 
zeb

zeb

Modérateur
Alors, tu y arrives à intégrer ce que je te propose là :
Vous devez être connecté pour voir les liens.

?
 
T

tithom_82

Habitué



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!!


Code: 
Option Explicit
Sub Macro_recrutement()
'
' // définition des variables

Dim f_re As Worksheet ' // Feuille recrutement
Dim f_dest As Worksheet ' // Feuille destination
Dim f_dest1 As Worksheet ' // Feuille destination
Dim f_dest2 As Worksheet ' // Feuille destination
Dim cible As Range
Dim cible1 As Range
Dim cible2 As Range
Dim ligne As Range
Dim feuille As Variant
Dim firstCol As Integer
Dim LastCol As Integer
Dim firstRow As Integer
Dim LastRow As Integer
Dim ConcatCol As Integer
Dim TitleRow As Integer
Dim i, j As Integer
Dim col_num As Variant
Dim LastLine As Long

' paramétrage des variables
Set f_re = Worksheets("Recrutement")
Set f_dest = Worksheets("Formation du recruté ")
Set f_dest1 = Worksheets("Sites utilisés et nbre candid")
Set f_dest2 = Worksheets("Feuil1")
firstCol = 12
LastCol = 22
firstRow = 6
LastRow = 60
ConcatCol = 39
TitleRow = 5

'ou se trouve la derniere ligne?
LastLine = f_re.Range("X65536").End(xlUp).Row
LastLine = LastLine + 15

'on efface les données des feuilles cible à partir de la ligne 4 jusq'a 100 ( pour le moment)
f_dest.Rows("4:" & LastLine).Delete '
f_dest1.Rows("4:" & LastLine).Delete
f_dest2.Rows("1:" & LastLine).Delete
 
'définition des cellules cibles
Set cible = f_dest.Range("A4")
Set cible1 = f_dest1.Range("A4")
Set cible2 = f_dest2.Range("E5")


'concaténation sur la colonne AM de f_re les titres des cellules de la colonne L à V si des valeurs y figurent

Worksheets("Recrutement").Select
    For j = firstRow To LastRow
             Cells(j, ConcatCol).Value = ""
    For i = firstCol To LastCol
     
            If Cells(j, i).Value <> "" Then
     
                If Cells(j, ConcatCol).Value <> "" Then
                     Cells(j, ConcatCol).Value = Cells(j, ConcatCol).Value & " / " & Cells(TitleRow, i).Value
                Else
                    Cells(j, ConcatCol).Value = Cells(TitleRow, i).Value
                End If
            End If
    Next
    Next

'Si RETENU dans colonne AI (35) alors copier colonne 5 3 36 29

   For Each ligne In f_re.Rows("6:" & LastLine)
 
             If ligne.Cells(35).Value Like "RETENU" Then
                For Each col_num In Array(5, 3, 36, 29)
                    ligne.Cells(col_num).Copy Destination:=cible
                    Set cible = cible.Offset(0, 1)
                Next
                    Set cible = cible.Offset(1, -4)
        
             End If
  
   Next

'Si qqch dans colonne x (24) alors copier colonne 5 3 10 24 39 (39 étant la concaténation préparé en amont.)


   For Each ligne In f_re.Rows("6:" & LastLine)
 
             If ligne.Cells(24).Value <> "" Then
                For Each col_num In Array(5, 3, 10, 24, 39)
                    ligne.Cells(col_num).Copy Destination:=cible1
                    Set cible1 = cible1.Offset(0, 1)
                Next
                    Set cible1 = cible1.Offset(1, -5)
             End If
   Next


'nettoyage des feuilles dest (plus de lignes, plus de couleur, pas de gras..)

For Each feuille In Array(f_dest, f_dest1, f_dest2)
   With feuille.Rows("4:" & LastLine)
        .Cells.Borders.LineStyle = xlNone
        .Font.Bold = False
        .Font.Color = vbBlack
        .Interior.ColorIndex = xlNone
    End With
Next
 
    
'suppression de la colonne qui permet la concaténation
Worksheets("Recrutement").Select
Columns("AM:AM").Delete Shift:=xlToLeft

'affichage de la page formation recruté
Sheets("Formation du recruté ").Select
Range("A1").Select
MsgBox "La dernière ligne non vide de la colonne A est la ligne " & LastLine

End Sub

si vous avez des remarques ( ce dont je ne doute pas.... :pt1cable: )
 
T

tithom_82

Habitué
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...)
Code: 
Dim f_re As Worksheet

Set f_re = Workbook("Trame suivi *").Worksheets("Recrutement")

Merci d'avance.
 
zeb

zeb

Modérateur
Meilleure réponse
Pas mal !

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

Ligne 39 :
Code: 
LastLine = LastLine + 15
Et si LastLine vaut 65522 ou plus ? :o
Improbable ne veut pas dire impossible !
Code: 
LastLine = Min(LastLine + 15, 65536)
[:glublutz:25]

Sauf que VB ne connaît pas la fonction Min() ... :pfff:
Code: 
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 !

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

:lol:

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

Ligne 113
Code: 
Worksheets("Recrutement").Select
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.
Code: 
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' :

Code: 
Dim wb As Workbook
For Each wb In Workbooks

	If wb Is ThisWorkbook Then
		' On fait quoi si on est dans le classeur qui contient la macro ?
	End If
	
	MsgBox "Je suis le classeur " & wb.Name
	
Next
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Dernières actus
Derniers messages publiés
Statistiques globales
Discussions
730 131
Messages
6 717 956
Membres
1 586 383
Dernier membre
potofeu
Partager cette page
Haut