Macro - 1 ligne = 1 valeur unique

Bonsoir à tous,

J'ai réalisé un plan d'entrepôt sous excel afin d'étudier de façon hebdomadaire le taux de remplissage de nos emplacements de palettes dans les racks.

J'ai donc créé dans un 1er onglet mon plan, je remplis celui-ci avec des "1" pour dire que l'emplacement est plein et avec une mise en forme conditionnelle, la couleur de la cellule et de la police change (le fichier sera parlant si je ne suis pas clair).

Dans un 2ème onglet, j'ai créé un rapport simple en créant un petit tableau avec le n° de semaine, le nombre d'emplacements occupés et donc le taux de remplissage...

Pour alimenter tout cela, j'ai enregistré une petite macro qui se lance via un bouton mais le soucis, c'est que lorsque je modifie l'occupation de mes emplacements, toutes les lignes de mon tableau sont recalculées ce qui fait que l'historique disparait...

J'aimerai que chaque nouvelle ligne créée soit une valeur unique qui ne bouge plus.

Je suis persuadé que c'est très facile à résoudre quand on connait un peu les macros (ce qui n'est pas mon cas)

Merci pour votre aide.

Bonjour

Un essai à tester. Te convient-il ?

Bye !

Bonjour,

Bonjour gmb,

Une autre proposition.

Cdlt.

Public Sub NouvelleAnalyse()
Dim ws As Worksheet, ws2 As Worksheet
Dim lo As ListObject
Dim r As Range
Dim iWeek As Double, ref As Double, n As Double
    Set ws = Worksheets("Plan")
    'Nombre emplacements réservés
    n = WorksheetFunction.CountIf(ws.UsedRange, 1)
    'Numéro semaine courante
    iWeek = WorksheetFunction.IsoWeekNum(VBA.Date)
    Set ws2 = Worksheets("Rapport")
    'Nombre emplacements total
    ref = ws2.Cells(4, 2).Value
    Set lo = Range("Tableau1").ListObject
    'Détermination cellule de restitution
    With lo
        If .InsertRowRange Is Nothing Then
            Set r = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
        Else
            Set r = .InsertRowRange.Cells(1)
        End If
    End With
    'Restitution des données
    With r
        .Value = iWeek
        .Offset(, 1).Value = n
        .Offset(, 2).Value = n / ref
    End With
    'Tri des données
    With lo
        .Sort.SortFields.Add Key:=.ListColumns(1).DataBodyRange, Order:=xlDescending
        .Sort.Header = xlYes
        .Sort.Apply
        .Sort.SortFields.Clear
    End With
End Sub

gmb a écrit :

Bonjour

Un essai à tester. Te convient-il ?

10suivi-remplissage-rack-v1.xlsm (34.38 Ko)

Bye !

Au top !!!

Merci beaucoup.

Merci pour vos solutions.

Tout fonctionne comme je le souhaite.

Bonne journée.