XL 2013 Remplir automatiquement les tableaux

job75 à dit:

Bonsoir lestoiles1,

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

VB:

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.

Cliquez pour agrandir...