1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
| Sub Dispatch()
Dim LastLig As Long, i As Long
Dim Sh As Worksheet
Dim Dico As Object
Application.ScreenUpdating = False
Set Dico = CreateObject("scripting.dictionary")
With Worksheets("Fiche de Travail J")
.AutoFilterMode = False
LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
'Création d'un dictionnaire sur les données de la colonne C
For i = 2 To LastLig
If Not Dico.exists(.Range("C" & i).Value) Then Dico.Add .Range("C" & i).Value, ""
Next i
'Filtrage automatique et copie
For i = 0 To Dico.Count - 1
.Range("A1:C" & LastLig).AutoFilter Field:=3, Criteria1:=Dico.Keys(i)
If Existe(Dico.Keys(i)) Then
Set Sh = ThisWorkbook.Worksheets(Dico.Keys(i))
Sh.UsedRange.Clear
Else
Set Sh = Worksheets.Add(After:=Sheets(Sheets.Count))
Sh.Name = Dico.Keys(i)
End If
.Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sh.Range("A1")
Next i
.AutoFilterMode = False
End With
Set Sh = Nothing
Set Dico = Nothing
End Sub
Function Existe(ByVal ShName As String) As Boolean
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Sheets
If Sh.Name = ShName Then
Existe = True
Exit For
End If
Next Sh
End Function |
