Function exist(Nom)
exist = False
On Error Resume Next
Set x = Sheets(Nom)
If Err.Number = 0 Then exist = True
On Error GoTo 0
End Function
Sub Balaye1()
tablo = Sheets("Base").Range("A1").CurrentRegion
Set dico = CreateObject("Scripting.dictionary")
For n = LBound(tablo, 1) + 1 To UBound(tablo, 1)
x = tablo(n, 1)
dico(x) = x
Next
a = dico.keys
For n = LBound(a) To UBound(a)
If Not exist(a(n)) Then
Sheets.Add.Name = a(n)
ActiveSheet.Move after:=Sheets(Sheets.Count)
Sheets("Base").Rows(1).Copy Destination:=ActiveSheet.Range("A1")
End If
ind = 0
ReDim tabres(UBound(tablo, 1), UBound(tablo, 2))
For m = LBound(tablo, 1) + 1 To UBound(tablo, 1)
If tablo(m, 1) = a(n) Then
For p = LBound(tablo, 2) To UBound(tablo, 2)
tabres(ind, p - 1) = tablo(m, p)
Next
ind = ind + 1
End If
Next
Sheets(a(n)).Range("A2").Resize(UBound(tabres, 1), UBound(tabres, 2)) = tabres
Next
End Sub