accélération code et doublons

Sub MEFC_Doublon()
t1 = Timer
Application.ScreenUpdating = False
For Each cell In Selection
    ActiveCell.Range("A1:E1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Next
        Application.ScreenUpdating = True
MsgBox Timer - t1
End Sub

Option Explicit
Option Base 1

Sub combinaisons()
    Dim m&, n&, o&, p&, q&, i&, aa, x$, t$, mondico As Object, a&, bb, nn
    t = Timer
    ReDim aa(3 * 5 * 7 * 8 * 9, 5)
    i = 1
        For m = 1 To 3
            For n = 2 To 5
                For o = 2 To 7
                    For p = 3 To 8
                        For q = 4 To 9
                            aa(i, 1) = m
                            aa(i, 2) = n
                            aa(i, 3) = o
                            aa(i, 4) = p
                            aa(i, 5) = q: i = i + 1
                        Next q
                    Next p
                Next o
            Next n
        Next m
    Set mondico = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(aa)
        For a = 1 To UBound(aa, 2)
            x = x & "#" & aa(i, a)
        Next a
        If Not mondico.exists(x) Then mondico.Add x, x
        x = ""
    Next i
aa = mondico.items
ReDim bb(UBound(aa), 5)
For i = 1 To UBound(aa)
nn = Split(aa(i), "#"): bb(i, 1) = nn(1): bb(i, 2) = nn(2): bb(i, 3) = nn(3): bb(i, 4) = nn(4): bb(i, 5) = nn(5)
Next i
Feuil1.Range("T2:X10000").Clear
Feuil1.Range("T2").Resize(UBound(bb), UBound(bb, 2)) = bb
MsgBox "Terminé en " & Format(Timer - t, "0.00 s")
End Sub

Option Explicit
Option Base 1

Sub combinaisons()
    Dim m&, n&, o&, p&, q&, i&, aa, x$, t$, mondico As Object, a&, bb, nn, y&, z&
    t = Timer
    ReDim aa(3 * 5 * 7 * 8 * 9, 5)
    i = 1
    For m = 1 To 3
        For n = 2 To 5
            For o = 2 To 7
                For p = 3 To 8
                    For q = 4 To 9
                        aa(i, 1) = m
                        aa(i, 2) = n
                        aa(i, 3) = o
                        aa(i, 4) = p
                        aa(i, 5) = q: i = i + 1
                    Next q
                Next p
            Next o
        Next n
    Next m
    Set mondico = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(aa)
        For z = 1 To UBound(aa, 2)
            For y = z + 1 To UBound(aa, 2)
                If aa(i, z) = aa(i, y) Then GoTo 1
            Next y
        Next z
        For a = 1 To UBound(aa, 2)
            x = x & "#" & aa(i, a)
        Next a
        If Not mondico.exists(x) Then mondico.Add x, x
        x = ""
1   Next i
    aa = mondico.items
    ReDim bb(UBound(aa) + 1, 5)
    For i = 0 To UBound(aa)
        nn = Split(aa(i), "#"): bb(i + 1, 1) = nn(1): bb(i + 1, 2) = nn(2): bb(i + 1, 3) = nn(3): bb(i + 1, 4) = nn(4): bb(i + 1, 5) = nn(5)
    Next i
    Feuil1.Range("T2:X10000").Clear
    Feuil1.Range("T2").Resize(UBound(bb), UBound(bb, 2)) = bb
    MsgBox "Terminé en " & Format(Timer - t, "0.00 s")
End Sub