VBA copier onglet et compléter des feuilles suivant un filtre

Bonjour à tous,

Je viens une nouvelle fois vers vous car je suis à la recherche d'un code afin d'automatisé la création de nouvel onglet.

Je m'explique, le but est qu'à chaque lancement de nouveau projet (au clic sur l'un des commandbutton), ça fasse un filtre sur la version cliquée décochant toutes les cases vides. Une fois le filtre réalisé, le code dit de copier la fiche_quinc autant de fois qu'il y a de N° meuble différents en nommant l'onglet "FQ" et le numéro de meuble en question (Ex : FQ_43_01_01)

Dans cette feuille, on retrouve en A2 le N° meuble, en colonne A, la colonne ref de QUINC. En colonne B, la colonne désignation de QUINC. Et en colonne C, la colonne Qté de QUINC. Je vous ai fait un exemple type sur l'onglet FQ_43_01_01.

2eme solution, peut-être un peu plus compliqué à coder, dupliquer la feuille Fiche_quinc une fois, et copier/coller les colonnes ABC à la suite (en colonne D puis en G etc), de façon à faire que un seul onglet et donc des économies de papier (j'imprimerai plusieurs FQ sur la même feuille)

Si ça peut m'éviter de ré-écrire toutes ces feuilles à chaque lancement, je vous en serait reconnaissant 😊
Je vous met le fichier en PJ pour que y voyiez plus clair :)

Merci d'avance

Bonjour,

Voici ce que vous devez faire dans votre fichier
- Renommer les boutons sur base du libellé que vous avez mis actuellement (très important)
- Ajouter les deux codes ci-dessous dans un module
- Lier chaque bouton à la macro creation

1. Code de tri

Sub Trier()
With ThisWorkbook.Worksheets("BDD_QUINC").ListObjects("QUINC")
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:=Range("QUINC[N° Meuble]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
End Sub

2. Code de création des feuilles

Sub creation()
Dim NomShape As String
Dim col As Byte
Dim tablo As Collection
Dim cel As Range
Dim item
Dim tb As ListObject

Call Trier

NomShape = Application.Caller
Set tb = Sheets("BDD_QUINC").ListObjects("QUINC")
col = Application.Match(NomShape, tb.HeaderRowRange, 0)

Set tablo = New Collection
On Error Resume Next
With ThisWorkbook
    For Each cel In tb.ListColumns(1).DataBodyRange
        If UCase(cel.Offset(0, col - 1)) = "X" Then
            tablo.Add cel.Value, CStr(cel.Value)
        End If
    Next cel
End With
On Error GoTo 0

Dim dlg As Integer, lig As Integer

Application.ScreenUpdating = False

For Each item In tablo
    ThisWorkbook.Worksheets("Fiche_quinc").Copy After:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = "FQ_" & item
        .Range("A1") = "QUINCAILLERIE MEUBLE"
        .Range("A2") = item
        lig = Application.Match(item, tb.ListColumns(1).DataBodyRange, 0)

        While tb.DataBodyRange(lig, 1) = item
            dlg = .Range("A" & Rows.Count).End(xlUp).Row + 1
            .Range("A" & dlg) = tb.DataBodyRange(lig, 2)
            .Range("B" & dlg) = tb.DataBodyRange(lig, 3)
            .Range("C" & dlg) = tb.DataBodyRange(lig, 4)
            lig = lig + 1
        Wend

    End With
Next item
End Sub

A l'exécution le code va :
- d'abord trier la base de données sur la colonne A
- créer les feuilles sur base du bouton cliqué et si un X est dans la colonne concernée par le bouton
- compléter les feuilles des articles pour lequel un X est mentionné

Cordialement

Bonjour Dan,

Merci une nouvelle fois de m'aider !

C'est niquel ça ! merci beaucoup !

Cordialement