Dispatcher un tableau vers les feuille adéquate

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)

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

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

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.