Rechercher dans un autre fichier et copier cellule référence

Ca marche impec, même sur mon fichier de production.

Sais-tu comment je dois adapter le code si je veux en plus importer la valeur de la case O99 dans la colonne AJ? est-ce que je duplique simplement la partie du code ci-dessous en changeant les valeurs pour matcher ma case et la colonne? j'ai essayé et ça marche mais ce n'est peut-être pas le plus beau à réaliser...

    If nomFicClients = "" Then
        MsgBox "annul"
    Else
        tpsDeb = Timer
        Application.ScreenUpdating = False

        Workbooks.Open (nomFicClients)
        nbrOng = Sheets.Count
        ReDim tabEts(1 To nbrOng, 1 To 2)
        For cptOng = 1 To nbrOng
            tabEts(cptOng, 1) = Sheets(cptOng).Cells(2, 1)
            tabEts(cptOng, 2) = Sheets(cptOng).Cells(99, 15)
        Next
        Windows(Dir(nomFicClients)).Close

        derLig = xlsWsRecap.Rows.Count
        cptLig = 0
        cptTrv = 0
        While Not (derLig = 2)
            If Not (xlsWsRecap.Cells(derLig, 11) = "") Then
                cptLig = cptLig + 1
                nomEts = xlsWsRecap.Cells(derLig, 11)
                numEts = TrouveEts(nomEts, tabEts)
                If numEts > 0 Then
                    xlsWsRecap.Cells(derLig, 36) = tabEts(numEts, 2)
                    cptTrv = cptTrv + 1
                End If
            End If
            derLig = derLig - 1
        Wend
    End If

Bonjour tetsunochin,

Désolé pour le retard... voici les 3 corrections à apporter pour intégrer la nouvelle donnée... regarde les lignes commentées...

        tpsDeb = Timer
        Application.ScreenUpdating = False

        Workbooks.Open (nomFicClients)
        nbrOng = Sheets.Count
        ' -------------------------------------------------------------------
        ' !!! Changer dans la ligne ci-dessous ligne ==> 1 To 2 en 1 To 3 !!!
        ' -------------------------------------------------------------------
        ReDim tabEts(1 To nbrOng, 1 To 3)
        For cptOng = 1 To nbrOng
            tabEts(cptOng, 1) = Sheets(cptOng).Cells(2, 1)
            tabEts(cptOng, 2) = Sheets(cptOng).Cells(59, 15)
            ' -----------------------------------
            ' !!! Ajouter la ligne ci-dessous !!!
            ' -----------------------------------
            tabEts(cptOng, 3) = Sheets(cptOng).Cells(15, 99)
        Next
        Windows(Dir(nomFicClients)).Close

        derLig = xlsWsRecap.Rows.Count
        cptLig = 0
        cptTrv = 0
        While Not (derLig = 2)
            If Not (xlsWsRecap.Cells(derLig, 11) = "") Then
                cptLig = cptLig + 1
                nomEts = xlsWsRecap.Cells(derLig, 11)
                numEts = TrouveEts(nomEts, tabEts)
                If numEts > 0 Then
                    xlsWsRecap.Cells(derLig, 35) = tabEts(numEts, 2)
                    ' -----------------------------------
                    ' !!! Ajouter la ligne ci-dessous !!!
                    ' -----------------------------------
                    xlsWsRecap.Cells(derLig, 36) = tabEts(numEts, 3)
                    cptTrv = cptTrv + 1
                Else
                    xlsWsRecap.Cells(derLig, 35) = "ABS"
                End If
            End If
            derLig = derLig - 1
        Wend

Quelques explications pour te permettre d'intégrer d'éventuelles autres données...

à chaque donnée supplémentaire il faut :

1. repérer en notation numérique les coordonnées de la cellule à récupérer (par exemple O99 correspond à la ligne 99 colonne 15)
2. repérer en notation numérique le numéro de la colonne où insérer cette donnée (par la colonne AJ correspond à la colonne 36)
3. modifier "aux nombres" de données ajoutées la première ligne commenté "Redim tabEts(1 To nbrOng, 1 To nouveauNombre)
4. ajouter à la suite de la 2ème ligne commentée tabEts(cptOng, 3) = Sheets(cptOng).Cells(15, 99)
   
   en changeant le 3 (à gauche de =) par le numéro de la donnée à ajoutée ET
   • en changeant les coordonnées de la cellule "cible" Cells(15,99) par les coordonnées repérées en 1