Dupliquer une feuille autant de fois selon le contenu d'une colonne

Bonjour à tous,

ça fait 2 jours que je suis sur un sujet qui se répète pas mal de fois mais que je n'arrive pas à trouver une solution adaptée à 100% à mon cas malgré que je testé une dizaine de macros

ça devient vraiment un grand problème pour mon projet vu que je n'arrive plus à avancer, pour cela je sollicite votre bienveillance dans l'espoir de trouver une solution efficace à mon problème (j'espère)

en fait, j'ai une feuille intitulée "BD" qui contient un tableau avec une liste de clients dans la colonne D, mon besoin est de créer une feuille par client tout en gardant le format exact de ma feuille 'BD' avec toutes les infos et graphiques qui ne touchent pas à mon tableau client

Pour simplifier le problème, ci-joint un exemple de mon classeur qui contient la feuille "BD" et 2 exemple de feuilles par client que je souhaite les créer en automatique car en réalité j'ai plusieurs données et plusieurs feuilles de ce type

J'ai testé le filtre avancé dans un onglet à part pour lister les clients sans doublons ensuite utiliser une boucle pour dupliquer la feuille source et la renommer selon le type de client mais ça n'a pas marché vraiment en plus que la macro était très lente

Pouvez vous m'aider svp ?

Merci d'avance

Bonjour Morino, bonjour le forum,

Le code ci-dessous fonctionne bien mais déstructure la bordure épaisse noire de la plage B2:L33. En la supprimant ça devrait aller... Désolé, pas le temps de commenter les codes comme j'ai l'habitude de le faire... Si tu as en besoin fais signe et je le ferai...

Sub Macro1()
Dim OS As Worksheet
Dim TV As Variant
Dim I As Integer
Dim D As Object
Dim TMP As Variant
Dim OD As Worksheet

Application.ScreenUpdating = False
Set OS = Worksheets("BD")
Application.DisplayAlerts = False
For I = Sheets.Count To 1 Step -1
    If Sheets(I).Name <> OS.Name Then Sheets(I).Delete
Next I
TV = OS.Range("Tableau1")
Set D = CreateObject("Scripting.Dictionary")
For I = 1 To UBound(TV, 1)
    D(TV(I, 3)) = ""
Next I
TMP = D.Keys
For J = 0 To UBound(TMP)
    OS.Copy After:=Sheets(Sheets.Count)
    Set OD = ActiveSheet
    OD.Name = TMP(J)
    TV = OD.Range("B14").CurrentRegion
    For I = UBound(TV, 1) To 3 Step -1
        If TV(I, 3) <> TMP(J) Then OD.Range("B" & 13 + I).Resize(1, 6).Delete
    Next I
Next J
End Sub

Bonjour, Salut ThauThème !

Sub GénérerFeuillesClients()
    Dim d As Object, k, tmp(), i%, n%, wsCli As Worksheet, Cli$
    Set d = CreateObject("Scripting.Dictionary")
    With ActiveSheet.ListObjects(1).DataBodyRange
        For i = 1 To .Rows.Count
            k = .Cells(i, 3)
            If d.exists(k) Then
                tmp = d(k): n = UBound(tmp) + 1
                ReDim Preserve tmp(n)
                tmp(n) = .Rows(i): d(k) = tmp
            Else
                ReDim tmp(0)
                tmp(0) = .Rows(i): d(k) = tmp
            End If
        Next i
    End With
    Application.ScreenUpdating = False
    Worksheets("Client_").Visible = xlSheetVisible
    For Each k In d.keys
        tmp = d(k): n = UBound(tmp) + 1: Cli = "Client_" & k
        Application.DisplayAlerts = False
        On Error Resume Next
        Worksheets(Cli).Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
        Worksheets("Client_").Copy after:=Worksheets("BD")
        Set wsCli = ActiveSheet: wsCli.Name = Cli
        With wsCli.ListObjects(1).DataBodyRange.Rows(1).Resize(n)
            .Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(tmp))
        End With
    Next k
    Worksheets("Client_").Visible = xlSheetHidden
    Worksheets("BD").Activate
End Sub

Bouton Feuilles Clients sur la feuille BD pour tester.

La feuille modèle Client_ est masquée.

Par sécurité, si la feuille client existe déjà elle est supprimée pour être remplacée.

Cordialement.

Salut ThauThème et MFerrand,

Merci beaucoup pour vos propositions

ça m'a aider énormément, je suis très reconnaissant

bon après midi et bon weekend