XL 2016 Redistribuer et réorganiser plusieurs valeurs

Sub feuilles()
Set dico = CreateObject("scripting.Dictionary")

With Sheets("A")
    fin = .UsedRange.Rows.Count
    For i = 2 To fin
        If Not dico.exists(Cells(i, 6) & "-" & Cells(i, 5)) Then
            dico.Add Cells(i, 6) & "-" & Cells(i, 5), i
        End If
    Next i
End With

With Sheets("Feuil1")
'MsgBox dico.Count
    .Range("A1").Resize(dico.Count) = Application.Transpose(dico.keys)
    .Range("B1").Resize(dico.Count) = Application.Transpose(dico.items)
End With

End Sub

Dim TabMass() As Variant

Set Dicomass = CreateObject("scripting.Dictionary")

With Sheets("A") 'dans la feuille "A"
    rows1 = .Cells(Rows.Count, "A").End(xlUp).Row 'rows count in sheet1
    TabMass = .Range("A2:L" & rows1).Value2


    For i = LBound(TabMass, 1) To UBound(TabMass, 1) 'on crée un dictionnaire pour avoir les EAN uniques
        Dicomass.Add TabMass(i, 1), i
    Next i

i = 1
For Each key In Dicomass.Keys
    If TabMass(i, 10) > 0 And TabMass(i, 1) <> "" Then
        maval = ("MASS - " & TabMass(i, 6) & " - " & CDate(TabMass(i, 5)))
        With Sheets(maval)
         .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = TabMass(Dicomass.Item(key), 1)
         .Range("A" & .Rows.Count).End(xlUp).Offset(0, 1) = TabMass(Dicomass.Item(key), 3)
         .Range("A" & .Rows.Count).End(xlUp).Offset(0, 2) = TabMass(Dicomass.Item(key), 10)
        End With
    End If

i = i + 1
Next key

Sub feuilles()
Application.ScreenUpdating = False
Set Dico = CreateObject("scripting.Dictionary") 'liste des feuilles à Créer
Set DicoFeuille = CreateObject("Scripting.dictionary") 'liste des feuilles déjà Créées

With Sheets("A") 'dans la feuille "A"
    fin = .UsedRange.Rows.Count 'dernière ligne
    For i = 2 To fin 'Dico=liste sans doublon des "Type - Date" (en remplacant le "/" par "."
        If Not Dico.exists(.Cells(i, 6) & "-" & WorksheetFunction.Substitute(.Cells(i, 5), "/", ".")) Then
            Dico.Add .Cells(i, 6) & "-" & WorksheetFunction.Substitute(.Cells(i, 5), "/", "."), i
        End If
    Next i
End With

With Sheets("Feuil1") 'juste pour le plaisir.. n'apporte rien à la suite de la macro
'MsgBox dico.Count
    .UsedRange.Clear 'on efface la feuille 1
    .Range("A1").Resize(Dico.Count) = Application.Transpose(Dico.Keys)
    .Range("B1").Resize(Dico.Count) = Application.Transpose(Dico.items)
End With

i = 1
For Each ws In Sheets 'on etabli la liste des feuilles existantes du classeur
    DicoFeuille.Add ws.Name, i
    i = i + 1
Next ws

For Each NomFeuille In Dico.Keys 'pour chaque feuille à Créer
    If Not DicoFeuille.exists(NomFeuille) Then 'si elle n'existe pas déjà
        ActiveWorkbook.Sheets.Add 'on ajoute une feuille
        ActiveSheet.Name = WorksheetFunction.Substitute(NomFeuille, "/", ".") 'on lui donne le nom "Type - Date"
        DicoFeuille.Add WorksheetFunction.Substitute(NomFeuille, "/", "."), i + 1 'on l'ajoute la liste des feuilles Créées
        i = i + 1
    End If
    'MsgBox NomFeuille
Next NomFeuille
Application.ScreenUpdating = True
End Sub

Sub RemplirFeuille()
Dim TabMass() As Variant

Set Dicomass = CreateObject("scripting.Dictionary")

With Sheets("A") 'dans la feuille "A"
    rows1 = .Cells(Rows.Count, "A").End(xlUp).Row 'rows count in sheet1
    TabMass = .Range("A2:L" & rows1).Value2


    For i = LBound(TabMass, 1) To UBound(TabMass, 1) 'on crée un dictionnaire pour avoir les EAN uniques
        Dicomass.Add TabMass(i, 1), i
    Next i
End With
i = 1
For Each Key In Dicomass.Keys
    If TabMass(i, 10) > 0 And TabMass(i, 1) <> "" Then
        'maval = ("MASS - " & TabMass(i, 6) & " - " & CDate(TabMass(i, 5)))
        maval = TabMass(i, 6) & "-" & WorksheetFunction.Substitute(CDate(TabMass(i, 5)), "/", ".")
        With Sheets(maval)
         .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = TabMass(Dicomass.Item(Key), 1)
         .Range("A" & .Rows.Count).End(xlUp).Offset(0, 1) = TabMass(Dicomass.Item(Key), 3)
         .Range("A" & .Rows.Count).End(xlUp).Offset(0, 2) = TabMass(Dicomass.Item(Key), 10)
        End With
    End If

i = i + 1
Next Key
End Sub