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)