Copier des valeurs d'une feuille à une autre feuille sous des conditions

[oum]

Bonjour a tous,
J’aurais besoin de votre aide sur une problématique, je cherche depuis longtemps mais sans solutions et c’est très urgent.
le but est de pouvoir affecter des articles à des emplacements sans avoir un article à côté d’un autre de même catégorie.
La première feuille contient un tableau de 6 colonnes chacune représente une catégories des articles.
la deuxième feuille contient les articles et les emplacement.
les emplacement sont des numéros allant de 1 à 36 et à chaque fois on répète.
la démarche est la suivante:
faire une boucle qui va parcourir le tableau des catégories en premier temps on va copier l’article de la première colonne et le coller dans la deuxième feuille et lui affecter 1 comme emplacement ensuite copier un autre article de la deuxième colonne et lui affecter 2 ainsi de suite jusqu’à ce qu’on arrive à 36, et répéter la même chose mais sans répéter les articles déjà affectés.
et lors de cette affectation si on trouve une catégories sans articles (case vide) on passe à la suivante.
je vous serais très très reconnaissante si vous pouviez m’aider .
Voilà mon fichier:
Affectation.xlsm (15,0 Ko)

[ouisansdoute]

Bonjour,

Une proposition de code

L = Sheets("categorie").UsedRange.Rows.Count 'nombre de lignes de l'onglet "Cat"
L_affe = 2 'numéro de la ligne de l'onglet affe
For I = 2 To L
    For C = 1 To 6 'colonnes de 1 à 6 onglet cat
        If Sheets("categorie").Cells(I, C).Value <> "" Then
          Sheets("emplacemant").Cells(L_affe, 1) = Sheets("categorie").Cells(I, C).Value
          L_affe = L_affe + 1
        End If
    Next
Next
' Suppression des doublons
    Sheets("emplacemant").Range("$A$2:$B" & L_affe).RemoveDuplicates Columns:=Array(1, 2), Header _
        :=xlYes
' numérotation
num = 1
Ligne = Sheets("emplacemant").UsedRange.Rows.Count - 1
    For X = 2 To Ligne
        If num <= 36 Then
            Range("B" & X) = num
            num = num + 1
        Else
            num = 1
            Range("B" & X) = num
            num = num + 1
        End If
    Next
        
End Sub

[oum]

@ouisansdoute

L = Sheets(« categorie »).UsedRange.Rows.Count 'nombre de lignes de l’onglet « Cat » L_affe = 2 'numéro de la ligne de l’onglet affe For I = 2 To L For C = 1 To 6 'colonnes de 1 à 6 onglet cat If Sheets(« categorie »).Cells(I, C).Value <> «  » Then Sheets(« emplacemant »).Cells(L_affe, 1) = Sheets(« categorie »).Cells(I, C).Value L_affe = L_affe + 1 End If Next Next ’ Suppression des doublons Sheets(« emplacemant »).Range(« $A$2:$B » & L_affe).RemoveDuplicates Columns:=Array(1, 2), Header _ :=xlYes ’ numérotation num = 1 Ligne = Sheets(« emplacemant »).UsedRange.Rows.Count - 1 For X = 2 To Ligne If num <= 36 Then Range(« B » & X) = num num = num + 1 Else num = 1 Range(« B » & X) = num num = num + 1 End If Next End Sub

merci ouisansdoute j’ai déjà réglé le problème d’affectation mais j’en avais besoin de la numérotation et ça m’a beaucoup aidé merci beaucoup c très gentil