XL 2013 Remplir automatiquement les tableaux

[lestoiles1]

Bonjour à tous,

Je veux que les tableaux se remplissent automatiquement par le Size et les Quantity lorsque j'ajoute des chiffres dans la ligne 6.
Notez que tous les quantity doivent être au nombre de 20 jusqu'à ce qu'il arrive au dernier balance ( j'ai mis en rouge).

Merci d'avance pour votre aide

Lestoiles1

 

[job75]

Bonsoir lestoiles1,

Voyez le fichier joint et cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pas%, source As Range, c As Range, col%(), i%, P As Range, j%, s
pas = 20 'à adapter
Set source = [B6:J6] 'à adapter
For Each c In source
    If IsNumeric(CStr(c)) Then
        ReDim Preserve col(i) 'base 0
        col(i) = c.Column - source.Column + 1
        i = i + 1
    End If
Next
Set P = [B9:B58,H9:H58,B61:B110,H61:H110,B113:B162,H113:H162] 'à adapter
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Union(P, P.Offset(, 1)).ClearContents 'RAZ
If i = 0 Then GoTo 1
i = 0: j = col(i)
For Each c In P
    c = source(0, j)
    s = s + pas
    If source(j) - s < pas / 2 Then 'pas / 2 à cause de C125 et C154, si j'ai bien compris...
        c(1, 2) = source(j) - s + pas
        s = 0
        i = i + 1
        If i > UBound(col) Then GoTo 1
        j = col(i)
    Else
        c(1, 2) = pas
    End If
Next
1 Application.EnableEvents = True 'réactive les évènements
End Sub

Elle se déclenche automatiquement quand on modifie ou valide une cellule quelconque.

Bonne nuit.

 

[lestoiles1]

Bonsoir lestoiles1,

Voyez le fichier joint et cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pas%, source As Range, c As Range, col%(), i%, P As Range, j%, s
pas = 20 'à adapter
Set source = [B6:J6] 'à adapter
For Each c In source
    If IsNumeric(CStr(c)) Then
        ReDim Preserve col(i) 'base 0
        col(i) = c.Column - source.Column + 1
        i = i + 1
    End If
Next
Set P = [B9:B58,H9:H58,B61:B110,H61:H110,B113:B162,H113:H162] 'à adapter
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Union(P, P.Offset(, 1)).ClearContents 'RAZ
If i = 0 Then GoTo 1
i = 0: j = col(i)
For Each c In P
    c = source(0, j)
    s = s + pas
    If source(j) - s < pas / 2 Then 'pas / 2 à cause de C125 et C154, si j'ai bien compris...
        c(1, 2) = source(j) - s + pas
        s = 0
        i = i + 1
        If i > UBound(col) Then GoTo 1
        j = col(i)
    Else
        c(1, 2) = pas
    End If
Next
1 Application.EnableEvents = True 'réactive les évènements
End Sub

Elle se déclenche automatiquement quand on modifie ou valide une cellule quelconque.

Bonne nuit.

Merci beaucoup