Sub test()
Dim DFeuille As Object
Dim i&, F As Worksheet, FTst As Worksheet
Set DFeuille = CreateObject("Scripting.dictionary")
Set F = Sheets("Base de données")
Application.ScreenUpdating = False
For i = 2 To F.Cells(F.Rows.Count, 1).End(3).Row
On Error Resume Next
Set FTst = Sheets(F.Cells(i, 6).Value)
If Err Then
Err.Clear
Sheets.Add(After:=Sheets(Sheets.Count)).Name = F.Cells(i, 6).Value
Set FTst = Sheets(F.Cells(i, 6).Value)
F.Range(F.Cells(1, 1), F.Cells(1, 11)).Copy FTst.Cells(1, 1)
DFeuille(F.Cells(i, 6).Value) = ""
End If
If Not DFeuille.exists(FTst.Name) Then
FTst.Range(FTst.Cells(2, 1), FTst.Cells(FTst.Rows.Count, 1).End(3)(1, 11)).ClearContents
DFeuille(FTst.Name) = ""
End If
F.Range(F.Cells(i, 1), F.Cells(i, 11)).Copy FTst.Cells(FTst.Rows.Count, 1).End(3)(2)
Set FTst = Nothing
Next i
F.Activate
End Sub