Test colonneA et renvoie d'une autres valeur déterminée colonneB

Bonjour à tous,

J'ai créer une macro qui cherche des valeurs spécifique dans une chaîne de valeurs (ex: F35001R-012-12) dans la colonne A et je veux qu'à chaque valeur trouvé qui se trouve au centre (ex: -012-), il envoie le nom de mon fournisseur dans la colonne B et sur la même ligne de chacune des valeurs trouvées.

J'ai passé quelques espion sur ma macro et tout fonctionne! J'ai aussi fait un test avec une ligne

ActiveCell.Offset(0, 1) = fournisseur

pour voir s'il me renvoyais le bon nom de fournisseur, le test est positif.

Il me reste juste à envoyer dans la colonne B et sur chacune des lignes correspondantes. Mais je n'y arrive pas!

J'ai pense que ça doit être réalisé avec la fonction

For each_next

pour faire ce que je veux, mais je suis pas certain.

Merci de votre aide!

Voici mon code:

Option Explicit
Sub fournisseur()

Dim dlig As Long
Dim colA As Range, colB As Range, trouve As Range
Dim firstAddr As String, fournisseur As String
Dim numéro As String
Dim r As Range
Dim i As Long

With ActiveSheet
dlig = Range("A8").End(xlDown).Row
Set colA = Range("A8:a" & dlig)
Set colB = Range("b8:b" & dlig)
End With

For i = 1 To 14
    On Error Resume Next
    On Error GoTo 0
    Select Case i

    Case 1
        numéro = "-000-"
        fournisseur = "Fourn1"
    Case 2
        numéro = "-001-"
        fournisseur = "Fourn2"
    Case 3
        numéro = "-002-"
        fournisseur = "Fourn3"
    Case 4
        numéro = "-003-"
        fournisseur = "Fourn4"
    Case 5
        numéro = "-004-"
        fournisseur = "Fourn5"
    Case 6
        numéro = "-005-"
        fournisseur = "Fourn6"
    Case 7
        numéro = "-006-"
        fournisseur = "Fourn7"
    Case 8
        numéro = "-007-"
        fournisseur = "Fourn8"
    Case 9
        numéro = "-008-"
        fournisseur = "Fourn9"
    Case 10
        numéro = "-009-"
        fournisseur = "Fourn10"
    Case 11
        numéro = "-010-"
        fournisseur = "Fourn11"
    Case 12
        numéro = "-011-"
        fournisseur = "Fourn12"
    Case 13
        numéro = "-012-"
        fournisseur = "Fourn13"
    Case 14
        numéro = "-013-"
        fournisseur = "Fourn14"
    End Select


Set trouve = colA.Find(what:=numéro, lookat:=xlPart, searchorder:=xlByColumns, searchdirection:=xlNext)



If Not trouve Is Nothing Then
    firstAddr = trouve.Address
End If

    Do Until trouve Is Nothing
    Debug.Print trouve.Address
    Set trouve = Range("a8:a" & dlig).FindNext(after:=trouve)
        If trouve.Address = firstAddr Then
            Exit Do
        End If
    Loop
    
For Each trouve In colA
    
    ActiveCell.Offset(0, 1) = fournisseur
    
Next
      
    
    
Next i
    
End Sub

Et voici mon fichier: https://www.cjoint.com/?0Cnqlni41IO

Merci!