Plusieurs résultalts dans une seule cellule ...

Private Sub CommandButton1_Click()
Dim i&, k&, result As String
result = ""
For i = 3 To Range("A65536").End(xlUp).Row + 1
    If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
        If Not Month(Cells(i - 1, 1).Value) = 6 Then
            result = result & " " & Cells(i - 1, 4).Value
        ElseIf Month(Cells(i - 1, 1).Value) = 6 And Left(Cells(i - 1, 4).Value, 2) = "AL" Then
            result = result & " " & Cells(i - 1, 4).Value
        End If
    Else
        result = result & " " & Cells(i - 1, 4).Value
        With Sheets("Feuil2")
            For k = 2 To .Range("A65536").End(xlUp).Row
                If Cells(i - 1, 1).Value = .Cells(k, 1).Value Then
                    .Cells(k, 2).Value = result
                    Exit For
                End If
            Next k
        End With
        result = ""
    End If
Next i
End Sub