Dispatcher un tableau vers les feuille adéquate

[ilies_meziani]

Bonjour
voici le code suivant qui dispatch ou bien qui affecte chaque ligne vers sa feuille qui corresponds.

Option Explicit
Sub Dispatcher()
Dim FeuilData As Worksheet, ShActuelle As Worksheet
Dim i As Long, j As Long, LastRow As Long
Dim Disco As New Dictionary
Dim Elem As Variant
Dim Arr As Variant
Set FeuilData = ThisWorkbook.Worksheets("Data")
Arr = Range("TblData")
For j = LBound(Arr, 1) To UBound(Arr, 1)
        Disco(Arr(j, 3)) = Disco(Arr(j, 3)) + 1
Next j

For Each Elem In Disco
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        Set ShActuelle = ThisWorkbook.Worksheets(Elem)
                    
            If Elem = Arr(i, 3) Then
                LastRow = ShActuelle.Cells(ShActuelle.Rows.Count, 1).End(xlUp).Row + 1
                Rows(LastRow + 1).Insert Shift:=xlDown
                ShActuelle.Range("A" & LastRow).Resize(, 4).Value = Array(Arr(i, 1), Arr(i, 2), Arr(i, 3), Arr(i, 4))
            End If
        
    Next i
Next Elem
End Sub

Svp est ce qu’il a une méthode plus rapide car mon tableau contient plus de 40000 lignes
merci
Dispatcher.xlsm (24,8 Ko)

[Cow18]

avec la méthode classique « autofilter », puis copy and paste, non ?
Cela prend combien de temps maintenant ?

[ilies_meziani]

Je vais calculer le temps et reformuler le code avec la methode classique et je vous informe