Dupliquer des lignes suivant un tableau

Sub transpose()
Dim a, b, w(), i As Long, j As Long, k As Long, n As Long
    Application.ScreenUpdating = False
    With Sheets("Liste clients").Range("A1").CurrentRegion
        a = .Value
    End With
    With Sheets("Table de données").Range("A1").CurrentRegion
        b = .Value
    End With
    ReDim w(1 To UBound(a, 1) * UBound(b, 1), 1 To 3)
    For i = 1 To UBound(a, 1)
        For j = 1 To UBound(b, 2)
            If a(i, 2) = b(1, j) Then
                For k = 2 To UBound(b, 1)
                    n = n + 1
                    w(n, 1) = a(i, 1)
                    w(n, 2) = b(k, 1)
                    w(n, 3) = b(k, j)
                Next
                Exit For
            End If
        Next
    Next
    With Sheets("Résultat").Cells(1)
        .CurrentRegion.Clear
        .Resize(, 3).Value = [{"Clients","Code famille","Remise"}]
        .Offset(1).Resize(n, 3).Value = w
        With .CurrentRegion
            With .Rows(1)
                .Font.Bold = True
                .Interior.ColorIndex = 40
                .BorderAround Weight:=xlThin
            End With
            .Font.Name = "calibri"
            .VerticalAlignment = xlCenter
            .HorizontalAlignment = xlCenter
            .Borders(xlInsideVertical).Weight = xlThin
            .BorderAround Weight:=xlThin
            '.Columns.AutoFit
        End With
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub