Générer plusieurs feuilles à partir d'un tableau

Bonsoir à tous,

Tout d'abord, je tiens à vous remercier pour l'aide que vous nous apporter au quotidien pour comprendre les fonctionnalités d'Excel.

Je dispose d'une base de données où il y a notamment les numéros de client et les numéros de commande. Je souhaiterai faire des affiches qui incrémentent automatiquement le numéro du client ainsi que de sa commande à partir de la base de données dans l'affiche et qui créé ainsi, autant d'affiche que de ligne dans le tableau... Je vous joint un fichier avec un exemple afin que ce soit plus simple à comprendre !

Je suis débutante en VBA et je n'ai aucune idée de comment pourrait être la formule... Je me demandais s'il était possible de faire une macro qui permettre de réaliser cela et de l'exporter sous PDF...

Je vous remercie pour votre aide !

Bonjour,

Une piste :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim Tbl()
    Dim I As Long
    Dim J As Long
    Dim Message As String

    'adapter le message à afficher
    Message = "MESSAGE"

    'défini la plage sur la colonne B de la feuille "Données" à partir de B3
    With Worksheets("Données"): Set Plage = .Range(.Cells(3, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With

    'stocke les valeurs dans un tableau
    For Each Cel In Plage

        I = I + 1
        ReDim Preserve Tbl(1 To 2, 1 To I)
        Tbl(1, I) = Cel.Value
        Tbl(2, I) = Cel.Offset(, 1).Value

    Next Cel

    With Worksheets("Affiche")

        'ôte le formatage existant
        With .Range("B:E")

            .Cells.Clear
            .UnMerge
            .Borders.LineStyle = xlNone
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlGeneral
            .Font.Bold = False

        End With

        'création des fiches
        For I = 1 To UBound(Tbl, 2)

            J = J + 4

            .Range("B" & J & ":E" & J + 1).Merge
            .Range("B" & J).Value = Message
            .Range("B" & J + 2 & ":C" & J + 2).Merge
            .Range("B" & J + 2).Value = Tbl(1, I)
            .Range("D" & J + 2 & ":E" & J + 2).Merge
            .Range("D" & J + 2).Value = Tbl(2, I)

            With .Range("B" & J & ":E" & J + 2)

                .Font.Bold = True
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlInsideVertical).LineStyle = xlContinuous
                .Borders(xlInsideHorizontal).LineStyle = xlContinuous

            End With

        Next I

    End With

End Sub

Bonjour et bonne année,

Une autre proposition à étudier.

Cdlt.

Option Explicit
Option Private Module

Public Sub Creer_Affiches()
Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim lo As ListObject
Dim lNum As Long
Dim I As Long, J As Long, K As Long

    Application.ScreenUpdating = False

    Set wb = ThisWorkbook
    With wb
        Set ws = .Worksheets("Données")
        Set ws2 = .Worksheets("Affiches")
    End With

    With ws2
        .Cells.Clear
    End With

    With ws
        Set lo = .ListObjects(1)
        lNum = lo.DataBodyRange.Rows.Count
        K = 3
        For I = 1 To lNum
            J = IIf(I Mod 2 = 0, 6, 2)
            Range("MESSAGE").Copy Destination:=ws2.Cells(K, J)
            With ws2
                .Cells(K + 1, J).Value = lo.DataBodyRange.Cells(I, 1).Value
                .Cells(K + 1, J + 1).Value = lo.DataBodyRange.Cells(I, 2).Value
            End With
            K = IIf(I Mod 2 = 0, K + 3, K)
        Next I
    End With

    ws2.Activate

    Set lo = Nothing
    Set ws2 = Nothing: Set ws = Nothing
    Set wb = Nothing

End Sub