Recherche et inscrire les données dans un autre tableau

Le 02/03/2016 à 09:31

Bonjour,

Je suis débutant en vb, je suis ici pour solliciter votre aide.

Je suis entrain de travailler sur tableau contenant deux feuilles, BD et Equipe.

Mon but, c'est de faire une recherche dans BD, avec comme critère "POSTEx".Ici j'ai pris pour exemple de recherche POSTE1.

Après je récupère les élément de la même ligne "mission" et "semaine".

Dans la deuxième feuille "Equipe" je fait une recherche de "POSTE1" et semaine et j'écris la mission dans la case correspondante à l'interesection. ici j'écris "MISSION5". Suivant l'entreprise qui est sur la même ligne, je vient colorié la cellule par un code couleur.

Un poste peut avoir plusieurs mission sur des semaines différentes.

Pour plus de détails je mets mon fichier en pièce jointe.

Merci d'avance de votre aide.

Voici mon code sur lequel je travail, sauf qu'il ne marche pas.

[code]Sub EQUIPE()
Dim poste As String
Dim semaine As String
Dim mission As String
Dim tabl, tabl_equipe As ListObject
Dim POSTES As Range

poste = "POSTE1"

Worksheets("BD").Activate
Set tabl = Sheets("BD").ListObjects("tab_mission") 'Mettre les données de la feuille "BD" dans le tableau "tabl"
    Set POSTES = Range(tabl.ListColumns(6).DataBodyRange.Address) 'Selection de la colonne 6, dans laquelle faire la recherche

    With POSTES
        Set c = .Find(poste, LookIn:=xlValues)
        If Not c Is Nothing Then

             mission = Range(c.Address).Offset(0, -5).Value ' Je recupère l'élément de la première colonne "mission" correspondant à l'adresse de la ligne trouvée
             semaine = Range(c.Address).Offset(0, 6).Value ' Je recupère l'élément de la colonne 12  "semaine" correspondant à l'adresse de la ligne trouvée

 ''''''''''''''''''' Recherche des coordonnées de la cellule''''''''''''''''''''''''

' je vais dans la feuille "equipe" chercher la cellule d'intersection formée par "POSTE1" et "semaine".

            Worksheets("Equipe").Activate
            Set tabl_equipe = Sheets("Equipe").ListObjects("tab_equipe")

            ' Recherche de la column
            With Range(tabl_equipe.ListRows(1).Range.Address)
                Set cel_col = .Find(semaine, Lookat:=xlWhole)
                If Not cel_col Is Nothing Then
                    Set col = Range(cel_col.Address)
                End If
            End With

            ' Recherche de la row
            With Range(tabl_equipe.ListColumns(1).Range.Address)
                Set cel_row = .Find(mission, Lookat:=xlWhole)
                If Not cel_row Is Nothing Then
                    Set c_row = Range(cel_row.Address)
                End If
            End With

            Worksheets("Equipe").Cells(c_row.Row, col.Column).Value = mission

        Set c = .FindNext(c)

        End If
    End With
Exit Sub
End Sub

[/code]

Le 02/03/2016 à 09:42

Bonjour

une petite lecture du point 6 ici aidera

http://miniurl.be/r-12tb

Le 02/03/2016 à 09:50

Merci de votre réponse, je vais regarder puis je reviendrai vers vous.

Bonne journée

Je viens de vérifier j'ai mis en pièce jointe un fichier en .xlsm

S'il n'est pas visible je peux le rajouter une deuxième fois.

Merci encore pour votre remarque

Le 02/03/2016 à 10:44