XL 2013 Macro pour une recherche et inscrire les données dans un autre tableau

[ngis]

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.

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.

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

 

[thebenoit59]

Re : Macro pour une recherche et inscrire les données dans un autre tableau

Je vois quand ton tableau BD tu peux avoir plusieurs Mission au même poste, la même semaine.
Ce qui risque de ne pas aider.

 

[ngis]

Re : Macro pour une recherche et inscrire les données dans un autre tableau

En effet, je peux voir plusieurs mission pour un même poste. Mais si j'ai la même semaine sur le même poste je changerai de date. Si vous avez une proposition sur lequel je peux partir, je suis preneur.