Scripting.Dictionary : La valeur Retourner =>Colonne Variable

Sub stade_Check()
Dim i As Long
Dim Avg As String, tod As Date, ColNum As Long, statut As String
Dim sh As Worksheet, shAct As Worksheet
Dim Dict, key As Variant, pl() As Variant, lig As Long, k As Long
    
Set sh = Worksheets("LIVRABLES")
Set shAct = Worksheets("Avancement Global")
tod = shAct.Range("A1").Value
Set Dict = CreateObject("Scripting.Dictionary")

Application.ScreenUpdating = False

 With sh
    pl = Range(.[A2], .Range("BC" & .[A65536].End(xlUp).Row)).Value
  End With
   

With shAct

    For i = 3 To Range("F" & Rows.Count).End(xlUp).Row
    .Cells(i, 8).NumberFormat = "m/d/yyyy"
        Avg = .Cells(i, 6).Value
            If Avg >= 2 And Avg < 10 Then
                .Cells(i, 7) = "Lancement"
            ElseIf Avg = 10 Then
                .Cells(i, 7) = "Début de Cheminement"
            ElseIf Avg > 10 And Avg < 34 Then
                .Cells(i, 7) = "En cours-Stade Cheminement"
            ElseIf Avg = 34 Then
                .Cells(i, 7) = "Fin Cheminement"
            ElseIf Avg > 34 And Avg < 80 Then
                .Cells(i, 7) = "En cours-Stade 2éme Bout"
            ElseIf Avg = 80 Then
                .Cells(i, 7) = "Fin 2éme Bout"
            ElseIf Avg > 80 And Avg < 90 Then
                .Cells(i, 7) = "En cours-Stade Contrôle"
            ElseIf Avg = 90 Then
                .Cells(i, 7) = "Fin Contrôle"
            ElseIf Avg > 90 And Avg < 97 Then
                .Cells(i, 7) = "En cours-Stade Teste"
            ElseIf Avg = 97 Then
                .Cells(i, 7) = "Fin Teste"
            ElseIf Avg > 97 And Avg < 100 Then
                .Cells(i, 7) = "En cours-d'embalage"
            ElseIf Avg = 100 Then
                .Cells(i, 7) = "Emballé"
            Else
                .Cells(i, 7) = "infos du VB non bien renseigner"
            End If
On Error Resume Next
 lig = 2
statut = .Cells(i, 7).Value
 .Cells(i, 9).NumberFormat = "m/d/yyyy"
    For Each key In pl
            If statut = "Lancement" Then
                Dict(key) = sh.Cells(lig, 27)
                lig = lig + 1
                Next key
            ElseIf statut = "Début de Cheminement" Then
                Dict(key) = sh.Cells(lig, 30)
                lig = lig + 1
                Next key
            ElseIf statut = "En cours-Stade Cheminement" Then
                Dict(key) = sh.Cells(lig, 35) & sh.Cells(lig, 38)
                lig = lig + 1
                Next key
            End If

    .Activate
    For lig = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(lig, 9) = Dict.Item(Cells(lig, 1).Value)
    Next lig
Next i
End With
End Sub