Super merci, j'ai du mal à mettre en place la macro dans mon fichier. Il doit y avoir une erreur dans le code que j'ai modifié car ça ne fonctionne pas. Peux-tu y jeter un œil ? J'ai changé les deux variables ART et FON.
Sub Recup_Commentaires()
Dim DerLig_BDD As Long, DerLig_TCD As Long, i As Long, j As Long
Dim Lig As Long
Dim ART As String, FON As String, C As String
Dim D As Object
Dim f1 As Worksheet, f2 As Worksheet
'********************************************************************************
Application.ScreenUpdating = False
Set f1 = Sheets("TAB_O (2)")
Set f2 = Sheets("TOT.TOUS BUDGETS")
f1.Columns("F").ClearContents
DerLig_BDD = f2.Range("A" & Rows.Count).End(xlUp).Row
DerLig_TCD = f1.Range("A" & Rows.Count).End(xlUp).Row
Set D = CreateObject("Scripting.dictionary")
For i = 2 To DerLig_TCD
If Left(f1.Cells(i, "A"), 4) = "ART" Then
Lig = i + 1
ART = f1.Cells(i, "A")
Do While Left(f1.Cells(Lig, "A"), 4) = "FON" And Lig <= DerLig_BDD
FON = f1.Cells(Lig, "A")
For j = 1 To DerLig_BDD
If f2.Cells(j, "H") = ART And f2.Cells(j, "J") = FON Then
C = ART & " " & FON
D(C) = D(C) & ", " & f2.Cells(j, "AK")
End If
Next j
If D.Count > 0 Then f1.Cells(Lig, "F").Resize(, 1) = Application.Transpose(D.items)
D.RemoveAll
Lig = Lig + 1
Loop
End If
Next i
Set f1 = Nothing
Set f2 = Nothing
End Sub
Ci-joint impression écran de mes 2 feuilles :
TOT.TOUS BUDGETS = ma BDD
TAB_O (2) = le TCD
Les commentaires sont à afficher dans la colonne F.
En te remerciant par avance