[RESOLU]Synthèse données dans plusieurs onglets

Sub testOK_III()
Dim ws As Worksheet, rX As Range, r As Range, Unique As Range, pf As Range
Application.ScreenUpdating = False
c = 2: Set ws = ThisWorkbook.Sheets("bdd1")

Set rX = Columns(c).Find("*", Cells(1, c), , , xlByColumns, xlPrevious)
ws.Range(Cells(4, c), Cells(rX.Row, c)).AdvancedFilter Action:=1, Unique:=True

Set Unique = Range(Cells(4, c), rX).SpecialCells(12)

For Each r In Unique
    If r <> "" Then
        If r <> "Modèle" Then
        ws.UsedRange.AutoFilter Field:=c, Criteria1:=r.Value
        Set pf = ws.Range("_FilterDataBase")
        pf.Range("A1").Offset(1, 0).Resize(pf.Rows.Count - 1).SpecialCells(12).Copy Destination:=Sheets(CStr(r)).Range("A4")
        End If
    End If
    Next

ws.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub