Vérification de plusieurs cases par ligne

Bonjour à tous,

Je travaille actuellement sur un projet comportant 3 fichiers:

• un fichier d'effectif d'une entreprise avec le nom et l'ID du hiérarchique de chaque collaborateur
• un fichier descriptif des différentes unités du périmètre défini par l'entreprise ( avec les ID des hiérarchiques de chaque unité)
• un fichier avec la hiérarchie de chaque collaborateur jusqu'à l'échelon le plus haut.

Mon but est de savoir dans quelle unité mon collaborateur se trouve donc pour tous les collaborateurs je recherche si je trouve l'ID du hiérarchique de chaque unité , si oui alors j'écris le nom de l'unité dans la case .

Du coup pour faire cela il faut rechercher dans les colonnes A à M de chaque ligne si on trouve l'ID et à partir du moment où on le trouve, passer à la ligne suivante.

Sub recherche_nouvelle()
'
' recherche Macro

'
' Déclaration des variables
Dim SESA As String
Dim celluletrouvee As Range
Dim ligne As Integer
Dim DrLig As Long, Lig As Long
Dim col As Integer
Dim numCol As Integer
Dim derniereLigne As Long
Dim derniereLigneDest As Long
Dim myRange As Range
Dim premiereLigne As Long
Dim premiereLigneDest As Long
Dim BU As String
Dim Structure As String
Dim Nom As String
Dim FeuilleSource As String
Dim FeuilleDestination As String
Dim BU_ As String
Dim STRUCT As String
Dim premiereLigneTri As String
Dim derniereLigneTri As String

'Déclaration des noms des feuilles et des numéros des premières lignes pour les 2 feuilles
FeuilleSource = "DescripteurBU"
FeuilleDestination = "hierarchie BU structure"
premiereLigne = 1
premiereLigneDest = 2

'Calcul des dernières lignes sur les deux feuilles
Sheets(FeuilleDestination).Select
derniereLigneDest = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
Sheets(FeuilleSource).Select
derniereLigne = Range("C" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne C

'Lancement d'une boucle qui lit les SESAS dans la feuille source sur une colonne définie
For compteur = premiereLigne To derniereLigne
    Sheets(FeuilleSource).Select
    BU = Range("A" & compteur).Value
    Structure = Range("B" & compteur).Value
    SESA = Range("D" & compteur).Value
    Nom = Range("C" & compteur).Value

    'Couleur verte de la case : on met le nom de la BU et de la structure à chaque collaborateur dont un des hiérarchiques à le SESA recherché
    If Range("D" & compteur).Interior.ColorIndex = 43 Then

        'MsgBox ("c'est vert")
        'Recherche du SESA dans la feuille de destination et si trouvé on écrit dans la colonne V la BU et dans la colonne W la structure
        Sheets(FeuilleDestination).Select
        For compteur2 = premiereLigneDest To derniereLigneDest
'            With Range("A" & premiereLigneDest & ":A" & derniereLigneDest)
'                Set celluletrouvee = .Find(SESA, LookIn:=xlValues)
'                If Not celluletrouvee Is Nothing Then
'                    firstAddress = celluletrouvee.Address
'                    Do
'                    MsgBox (celluletrouvee.Address)
'                    ligne = celluletrouvee.Row
'                    MsgBox (BU_STRUCTURE & "ligne " & ligne)
'                    Range("V" & ligne).Value = BU
'                    Range("W" & ligne).Value = Structure
'                    Set celluletrouvee = .FindNext(celluletrouvee)
'                    Loop While Not celluletrouvee Is Nothing And celluletrouvee.Address <> firstAddress
'                End If
'            End With

             With Range("A" & premiereLigneDest & ":J" & derniereLigneDest)
                    Set celluletrouvee = .Find(what:=SESA, LookIn:=xlValues)
                    If Not celluletrouvee Is Nothing Then
                        firstAddress = celluletrouvee.Address
                        Do
                        'MsgBox (celluletrouvee.Address)
                        ligne = celluletrouvee.Row
                        'MsgBox (BU_STRUCTURE & "ligne " & ligne)
                        Range("V" & ligne).Value = BU
                        Range("W" & ligne).Value = Structure
                        Set celluletrouvee = .FindNext(celluletrouvee)
                        Loop While Not celluletrouvee Is Nothing And celluletrouvee.Address <> firstAddress
                    End If
            End With

        Next
        'case orange signifie qu'on prend les collaborateurs appartenant à une BU et n'étant pas dans une des structures définies précédemment
    ElseIf Range("D" & compteur).Interior.ColorIndex = 44 Then
        'MsgBox ("c'est orange")
        Sheets(FeuilleDestination).Select
        ActiveSheet.Range("$A$1:$W$99985").AutoFilter Field:=22, Criteria1:= _
        BU
        ActiveSheet.Range("$A$1:$W$99985").AutoFilter Field:=23, Criteria1:="="
        For compteur2 = premiereLigneDest To derniereLigneDest
            If Rows(compteur2).Hidden = False Then
                Range("W" & compteur2).Value = Structure
            End If
        Next
    Else
     MsgBox ("Quelle est cette couleur?")
    End If

Next
MsgBox ("fin du traitement")

'
End Sub

Si vous pouviez trouver pourquoi je fais soit une boucle infinie soit je ne récupère pas tous les collaborateurs que je devrai, ce serait génial.

Merci pour votre aide

bonjour

pour relier des tableaux de données entre eux, utiliser RECHECHEV

joins un extrait de ton fichier (anonymisé si besoin)