Déplacement de valeur dans des cellules

Bonjour SVP j'ai besoin de votre aide :

j'ai fait une macro qui me gére le passages des chaines de caractére placer dans la colonne A mais malheuresement pas comme il faut :

en faite moi j'ai la ligne 7 ce remplie automatique la cellule M15 prend la valeur 53 et aprés 1 seconde elle l'envois a M15 et M14 recois de nouveau 53 et aisi de suite jusqu' la cellule T7

ce que je veux maintenant c'est que lorsque M14 est différente du vide que O7 recois A7 et quand M15 est differente du vide P7 recois A7 et O7 recois A8 et aisi de suite jusqua trouver une cellule vide dans la colonne A puis s'arréter

VOILA LE CODE QUE j'ai ecris mais il fonctionne pas bien

merci

Sub EntreePasses()
Dim j As Long
Dim TUN1(2, 6) As String
Dim m As String
For j = 0 To 4
If Range("O7") <> "" Then Cells(8, 20 - j) = Cells(8, 19 - j).Value
If Range("P7") <> "" Then Cells(8, 19 - j) = Cells(8, 18 - j).Value
If Range("Q7") <> "" Then Cells(8, 18 - j) = Cells(8, 17 - j).Value
If Range("R7") <> "" Then Cells(8, 17 - j) = Cells(8, 16 - j).Value
If Range("S7") <> "" Then Cells(8, 16 - j) = Cells(8, 15 - j).Value
If Range("T7") <> "" Then Cells(8, 15 - j) = Cells(8, 14 - j).Value
j = j + 1
Next j
Cells(8, 15) = Range("B5").Value
End Sub

Bonjour,

le plus facile pour sera de join un fichier du genre celui en image

la valeur vérifier est la ligne 7 (O,P,Q..) ou la colonne "A" ? et pourquoi au final la 1er case ("O8") prend la valeur 53 ?

voila mon fichier sur le quel je travail et la macro s'appelle EntreePasses elle est dans le module Tunel

appuiez sur le boutons simulation et vous aller voir comment sa fonctionne actruellement il fonctionne pas comme il faut , moi je veux ce que je vous est dit au début

merci pour la réponse

Bonjour,

ci-dessous code

Sub EntreePasses()
    Dim cellule As Range

    For Each cellule In [O7:T7].Cells
        If cellule = "" Then cellule = [A7].Offset(cellule.Column - [O7].Column)
    Next

End Sub

merci Thev mais malheureusement c'est pas ce que je veux

moi en faite

j'ai la valeur 53 qui placer dans la cellule B1

ce que je veux faire c'est une macro qui récupère 53 et me la met dans la cellules O7 et en même temps en vérifie si O7 est non vide si oui je prend A7 et je la met dans O8

après une seconde je déplace la valeur 53 de O7 a P7 et la valeur O8 a P8 et je récupère 53 de nouveau de la cellule B1 et je la met dans O7 et je récupère A8 et je la met dans O8

et après une seconde en refais la même chose en déplace en déplace tous vers la colonne Q et en remplis de nouveau la colonne O

j'espére que j'arrive a me faire comprendre mieux

Bonjour,

D'après ce que j'ai cru comprendre

Sub EntreePasses()
    Dim cellule As Range
    Dim i As Integer

    If [O7] = "" Then
        For Each cellule In [O7:T7].Cells
            'remplissage cellules O7 et O8
             [O7].Value = [B1].Value
            [O8].Value = [A7].Offset(cellule.Column - [O7].Column).Value

            'décalage cellules après une seconde
             Application.Wait (Now + TimeValue("0:00:1"))
            i = cellule.Column - [O7].Column + 1
            If i < [O7:T7].Columns.Count Then
                [P7].Resize(, i).Value = [O7].Resize(, i).Value
                [O7] = Empty
                [P8].Resize(, i).Value = [O8].Resize(, i).Value
                [O8] = Empty
            End If
        Next
    End If

End Sub

Merci beaucoup Thev vous etes vraiment trés gentil vous m'avez résolus la premiére parti de mon probléme merci

maintenant ce que vous m'avez fait c'est exactement ce que je veux sauf que maintenant je dois rajouté la deuxiéme parti qui relié a ce que vous m'avez fais

en faite maintenant je veux que lorsque la colonne T se remplie que d’envoi ca valeur a la colonne AE en la mettant a l'endroit qui lui correspond

par exemple pour A T7 J'ai 53 qui correspond a Plat2 donc il faut l'envoyer a la cellule AE4 et ensuite une fois que AE4 est non vide il faut que la colonne T reçois la valeur de la colonne S et la colonne S reçois la valeur de la colonne R ET

la colonne R reçois la valeur de la colonne Q ET la colonne Q reçois la valeur de la colonne P

ET la colonne P reçois la valeur de la colonne O

et je veux svp que la boucle tourne jusq' que toutes les cellules de la colonne Z soit non vide

merci beaucoup vous êtes mon sauveur en vba

voila les amis j'ai simplifié un peu se que je veux faire si vous pouvez m"aider svp

SVP maintenant mes lignes 7 et 8 ce remplice avec la macro que je vais vous déposé si dessous

ce que je veux faire pour la suite de mon travail c'est que lorsque les cellules T7 et T8 se remplissent (donc quand c'est non vide ) j'envoi la valeurs de T7 dans la colonne AD dans la cellules qui lui correspond dans notre cas a 53 sera envoyer vers Plat2

ensuite une fois que la cellules T7 est envoyé T7 resoit la valeur de S7 et T8 resoit la valeur de S8 et toutes les celules les lignes 7 et 8 seront decalé vers la droite et on aurra O7 et O8 qui seront vide et si O7 et O8 sont vide en relonce la boucle de remplissage de Tunel

merci

' entrée passe dans le tunel
Sub EntreePasses()
    Dim cellule As Range
    Dim i As Integer

    If [O7] = "" Then
        For Each cellule In [O7:T7].Cells
            'remplissage cellules O7 et O8
            [O7].Value = [B1].Value
            [O8].Value = [A7].Offset(cellule.Column - [O7].Column).Value

            'décalage cellules après une seconde
            Application.Wait (Now + TimeValue("0:00:1"))
            i = cellule.Column - [O7].Column + 1
            If i < [O7:T7].Columns.Count Then
                [P7].Resize(, i).Value = [O7].Resize(, i).Value
                [O7] = Empty
                [P8].Resize(, i).Value = [O8].Resize(, i).Value
                [O8] = Empty

            End If
        Next
    End If

End Sub

Bonjour,

ci-joint code partie 2

Sub partie2()

    Dim cellule As Range
    Dim i1, i2 As Integer

    If [T7] <> "" Then
        For Each cellule In [O7:T7].Cells
            'remplissage plage approvisionnement
             GoSub plage_appro

            'décalage cellules après une seconde
             Application.Wait (Now + TimeValue("0:00:1"))
            i1 = cellule.Column - [O7].Column
            i2 = [O7:T7].Columns.Count - (cellule.Column - [O7].Column + 1)
            If i2 > 0 Then
                [P7].Offset(, i1).Resize(, i2).Value = [O7].Offset(, i1).Resize(, i2).Value
                [P8].Offset(, i1).Resize(, i2).Value = [O8].Offset(, i1).Resize(, i2).Value
            End If
            [O7].Offset(, i1) = Empty
            [O8].Offset(, i1) = Empty
        Next
    End If

    'Fin procédure
    Exit Sub

' ****** routine remplissage plage approvisionnement *********
plage_appro:
    'définition plage approvisionnement
     Set plage_appro = Range([Z1], [AE:AE].Find("*", SearchOrder:=xlRows, SearchDirection:=xlPrevious))

    'recherche valeur T8
     Set cel_val_T8 = plage_appro.Find([T8], SearchOrder:=xlColumns, SearchDirection:=xlPrevious)
    adresse_initiale = cel_val_T8.Address
    Do
        If cel_val_T8.Offset(1) = "" Then
            cel_val_T8.Offset(1) = [T7].Value
            Exit Do
        End If
        Set cel_val_T8 = plage_appro.FindPrevious(cel_val_T8)
    Loop Until cel_val_T8.Address = adresse_initiale

    Return
' ****** fin routine remplissage plage approvisionnement *********

End Sub

merci beaucoup then mais je vois pas pourquoi la macro ne fonctionne pas chez moi je l'est coller dans mon fichier excel mais ca marche pas

j'ai lu le code que tu ma ecrit et je suis surr que c'est vraimen ce que je veux mais je vois pas pourquoi quand je l'execute il m'affiche rien

Par rapport à ton exemple, il y a un décalage d'une colonne

correction :

    'définition plage approvisionnement
     Set plage_appro = Range([Y1], [AD:AD].Find("*", SearchOrder:=xlRows, SearchDirection:=xlPrevious))

je c'est pas pourquoi ca marche pas j'ai essayer avec

  'définition plage approvisionnement
    Set plage_appro = Range([Y1], [AD:AD].Find("*", SearchOrder:=xlRows, SearchDirection:=xlPrevious))

et j'ai essayer ca aussi

  'définition plage approvisionnement
    Set plage_appro = Range([Y2], [AD:AD].Find("*", SearchOrder:=xlRows, SearchDirection:=xlPrevious))

voila le fichier regarde le stp stp thev

et je suis vraiment désolé je t'est trop déranger

C'est bon thev merci beaucoup je l'est mis dans mon fichier ou j'ai le remplissage du tunel et ca marche

merci beaucoup encore

thev stp j'ai deux questions stp

1- j'ai remarquer en faite que ma ligne 8 se remplis pas comme il faut en faite je veux que qu'on j'execute ma boucle IL FAUT QU4ELLE SUIT LE CADENCEMENT QUE J'AI DANS A7 :

T8=Plat2

S8=Plat5

R8=Plat3

Q8=Plat4

P8=Plat5

O8=Plat6

et quand O8 se vide il faut quil continue le cadenecemnt et il prend directement Plat8 placer dans la cellule A14 et ensuite quand P8 resoit O8

O8 il va reprendre Plat5 et ainsi de suite et je veux stp a chaque remplissage de T7 je veux que la celulle B3 s'incrémente

B3=B3+T7

voila le code que j'ai fait mais il fonctionne pas comme je veux merci beaucoup

' Gestion entrée passes dans le tunel en fonction du cadencement
Sub EntreePasses()
    Dim cellule As Range
    Dim i As Integer, j As Integer
    j = 7
Do While Sheets("Interface").Cells(j, 1).Value <> ""
    If [O7] = "" Then
        For Each cellule In [O7:T7].Cells
            'remplissage cellules O7 et O8
            [O7].Value = [B1].Value
            [O8].Value = [A7].Offset(cellule.Column - [O7].Column).Value

            'décalage cellules après une seconde
            Application.Wait (Now + TimeValue("0:00:1"))
            i = cellule.Column - [O7].Column + 1
            If i < [O7:T7].Columns.Count Then
                [P7].Resize(, i).Value = [O7].Resize(, i).Value
                [O7] = Empty
                [P8].Resize(, i).Value = [O8].Resize(, i).Value
                [O8] = Empty

            End If
        Next

         Range("B3") = Range("B3") + [T7].Value
    End If
     j = j + 1
     Loop
Call partie2
End Sub

' gestion de l'approvisonnement
Sub partie2()

    Dim cellule As Range
    Dim i1, i2 As Integer
    Dim plage_appro As Range, cel_val_T8 As Range
    Dim adresse_initiale As String
    If [T7] <> "" Then
        For Each cellule In [O7:T7].Cells
            'remplissage plage approvisionnement
            GoSub plage_appro

            'décalage cellules après une seconde
            Application.Wait (Now + TimeValue("0:00:1"))
            i1 = cellule.Column - [O7].Column
            i2 = [O7:T7].Columns.Count - (cellule.Column - [O7].Column + 1)
            If i2 > 0 Then
                [P7].Offset(, i1).Resize(, i2).Value = [O7].Offset(, i1).Resize(, i2).Value
                [P8].Offset(, i1).Resize(, i2).Value = [O8].Offset(, i1).Resize(, i2).Value
            End If
            [O7].Offset(, i1) = Empty
            [O8].Offset(, i1) = Empty
        Next
    End If

    'Fin procédure
   Exit Sub

' ****** routine remplissage plage approvisionnement *********
plage_appro:
    'définition plage approvisionnement
    Set plage_appro = Range([Z1], [AE:AE].Find("*", SearchOrder:=xlRows, SearchDirection:=xlPrevious))

    'recherche valeur T8
    Set cel_val_T8 = plage_appro.Find([T8], SearchOrder:=xlColumns, SearchDirection:=xlPrevious)
    adresse_initiale = cel_val_T8.Address
    Do
        If cel_val_T8.Offset(1) = "" Then
            cel_val_T8.Offset(1) = [T7].Value
            Exit Do
        End If
        Set cel_val_T8 = plage_appro.FindPrevious(cel_val_T8)
    Loop Until cel_val_T8.Address = adresse_initiale

    Return
' ****** fin routine remplissage plage approvisionnement *********

End Sub

si je veux que mon tunel se vide pas et que les passe entre en continue c'est a dire que une fois que P7 et P8 se vide il faux que je relance ma boucle ? quest ce que je dois modifié dans ma macro ?

OK. Je regarde.

Ce code devrait mieux répondre à ton problème

' entrée passe dans le tunel
Sub EntreePasses()
    Dim plat As Range
    Dim i0 As Integer

    With Sheets("Interface")

        'définition plage plats
        Set plage_plats = Range(.[A7], .[A:A].Find("*", SearchOrder:=xlRows, SearchDirection:=xlPrevious))

        ' remplissage approvisionnement via tunnel
        For Each plat In plage_plats

            If .[O7] = "" Then
                'remplissage cellules O7 et O8
                .[O7].Value = .[B1].Value
                .[O8].Value = plat.Value
                If .[T7] = "" Then
                    'décalage cellules après une seconde si tunnel non plein
                    Application.Wait (Now + TimeValue("0:00:1"))
                    i0 = .[O7:T7].Columns.Count - 1
                    .[P7].Resize(, i0).Value = .[O7].Resize(, i0).Value
                    .[O7] = Empty
                    .[P8].Resize(, i0).Value = .[O8].Resize(, i0).Value
                    .[O8] = Empty
                End If
            End If

            If .[T7] <> "" And .[O7] <> "" Then          'tunnel plein
                    'remplissage plage approvisionnement
                    GoSub plage_appro

                    'décalage cellules après une seconde
                    Application.Wait (Now + TimeValue("0:00:1"))
                    i0 = .[O7:T7].Columns.Count - 1
                    .[P7].Resize(, i0).Value = .[O7].Resize(, i0).Value
                    .[O7] = Empty
                    .[P8].Resize(, i0).Value = .[O8].Resize(, i0).Value
                    .[O8] = Empty
            End If

        Next

    End With

    'Fin procédure
    Exit Sub

' ****** routine remplissage plage approvisionnement *********
plage_appro:
    'définition plage approvisionnement
    With Sheets("Interface")
        Set plage_appro = Range(.[Y1], .[AD:AD].Find("*", SearchOrder:=xlRows, SearchDirection:=xlPrevious))

        'recherche valeur T8
        Set cel_val_T8 = plage_appro.Find(.[T8], SearchOrder:=xlColumns, SearchDirection:=xlPrevious)
        adresse_initiale = cel_val_T8.Address
        Do
            If cel_val_T8.Offset(1) = "" Then
                cel_val_T8.Offset(1) = .[T7].Value
                Exit Do
            End If
            Set cel_val_T8 = plage_appro.FindPrevious(cel_val_T8)
        Loop Until cel_val_T8.Address = adresse_initiale

    End With

    Return
' ****** fin routine remplissage plage approvisionnement *********

End Sub

MERCI beaucoup t'est vraiment génial

c'est exactement ca ce que je veux faire pour la gestion du tunel maintenent je vais juste rajouté qq trucs car moi je veux pas quel s'arréte de remplire le tunnel avant que les cellules d'approvisionnement soit rempli merci beaucoup

Bonjour j'ai fait une autre configuration a mon fichier et comme c'est toi qui ma aider sur la partis cadencement je me suis dit peut être tu pourra m'aider pour mon sujet actuel

en faite je suis sur le même objectif que la dernière fois

sauf que maintenant j'ai fait une macro qui me fait toute la simulation mais malheureusement il suit pas le cadencement ; il simule le passage de toute les produit depuis le tunel jusqu'au finition sauf que avec cette macro les produit se lance sans q'uil suivent le cadencement .

voila la macro que j'ai fait mais malheureusement j'ai pas pu mettre le fichier avec le fonctionnement normal de la macro en pièces jointes car il est trop grand j'ai mis un fichier juste pour te permettre de voir sur quoi agit la macro .

je vais te mettre une photo pour comprendre de quoi il s'agit

Option Explicit
Option Base 1           '--- la numérotation des tableaux (arrays) commence à 1

'--- 99 familles de produit
Dim FPcode(99) As String        '--- tous les codes DOIVENT se terminer par 2 chiffres 01, 02, ... 99
Dim FPnom(99) As String
Dim FPSechTyp(99) As String
Dim FPSechTemps(99) As Single
Dim FPCalTyp(99) As String
Dim FPCalTemps(99) As Single
'---
Dim kCSF As Long    '--- n° colonne Sortie Finale
Dim kRSF As Long    '--- n° ligne Sortie Finale
Dim kCt As Long     '--- n° colonne tunnels
Dim kCs As Long     '--- n° colonne séchoirs
Dim kCc As Long     '--- n° colonne calandreuses
Dim kRFP As Long    '--- n° ligne famille produit
Dim kRtFin As Long  '--- n° dernière ligne tunnel
Dim kRsFin As Long  '--- n° dernière ligne séchoirs
Dim kRcFin As Long  '--- n° dernière ligne calandres
Dim nFP As Long     '--- nombre de produits à traiter
Dim nSF As Long     '--- nombre de produits en sortie finale

Private Sub InitialiserFP()                                 '--- FP Famile Produit
    Dim wshD As Worksheet, kR As Long, i As Long, t As Variant
    Set wshD = ActiveWorkbook.Worksheets("Donnees")
    kR = 2                                              '--- commencer ligne 2
    With wshD
        While Len(.Cells(kR, 1)) > 0
            i = Val(Right(.Cells(kR, 11), 2))
            FPnom(i) = .Cells(kR, 1)                    '--- nom
            FPcode(i) = .Cells(kR, 1)                  '--- code   (1 au lieu de 11)
            FPSechTyp(i) = .Cells(kR, 6)                '--- type séchoir
            t = .Cells(kR, 7)
            t = Hour(t) * 24 + Minute(t)
            FPSechTemps(i) = t / 1440                   '--- cycle séchoir (conversion heures en secondes)
            FPCalTyp(i) = .Cells(kR, 8)                 '--- type calandre
            FPCalTemps(i) = FPSechTemps(i)              '--- cycle calandre = cycle sechoir --- à modifier
            kR = kR + 1
            'Debug.Print FPcode(i), FPSechTemps(i)
        Wend
    End With
    Set wshD = Nothing
End Sub

Sub Simulation()
    Dim dH As String, hFin As Single
    '--- initialisatoon
    InitialiserFP
    nFP = 0
    nSF = 0
    kCt = [C1].Column               '--- colonne Machine Tunnel
    kCs = [K1].Column               '--- colonne Machine Séchoirs
    kCc = [S1].Column               '--- colonne Machine Calandres
    kCSF = [AA1].Column             '--- colonne Sortie Finale
    kRcFin = Range("S" & Rows.Count).End(xlUp).Row  '--- dernière ligne colonne Z, sorties caladreuses
    kRsFin = Range("K" & Rows.Count).End(xlUp).Row  '--- dernière ligne colonne R, sorties séchoirs
    kRtFin = Range("C" & Rows.Count).End(xlUp).Row  '--- dernière ligne colonne J, sorties tunnels
    kRSF = 2                        '--- première ligne Sortie Finale
    kRFP = 21                       '--- première ligne famille produit
    [B8] = [B6] + 1                 '--- 1 jour  ======================= simulation sur 1 jour (24 heures)
    hFin = [B8]                     '--- heure fin
    dH = 1 / 24 / 60                '--- 1 minute --- pas de temps de la simulation
                                    '---              1 minute = 1 jour / 24 heures / 60 minutes
    [B8] = [B6]                     '--- B6 heure actuelle = B5 heure départ
    '--- boucle de simulation
    While [B8] <= hFin
        SimulerProduit
        [B8] = [B8] + dH
        'If MsgBox("Simuler minute " & Format([B8], "hh\h mm\'"), vbYesNo + vbDefaultButton1, "Continuer") = vbNo Then Exit Sub
        DoEvents
        If nSF = nFP Then
            MsgBox "Tous les produits ont été traités"
            Exit Sub
        End If
    Wend
End Sub

Sub SimulerProduit()
    Dim kR As Long, hMax As Single, kC As Long
    '--- sortir les produits traités de leurs machines
    '--- sorties calandreuses
    For kR = 4 To kRcFin Step 6                         '--- 4: première ligne produit en première calandre
        If Cells(kR, kCc + 6) = "" Then
            '--- rien, machine vide
        Else
            If [B8] >= Cells(kR + 4, kCc + 6) Then             '--- si l'heure est atteinte
                '--- mettre le produit en sortie, en déplaçant toute la file vers la droite
                Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 6)).Copy
                Cells(kR, kCc + 2).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
                [B8].Select
                '--- vider première colonne file approvisionnement
                Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 1)).ClearContents
            End If
        End If
    Next kR
    '--- envoyer sorties calandreuses vers sortie finale
    For kR = 4 To kRcFin Step 6                         '--- 4: première ligne produit en première calandre
        If Cells(kR, kCc + 7) <> "" Then
            Cells(kRSF, kCSF) = Cells(kR, kCc + 7)      '--- copie la sortie en Sortie Finale
            Cells(kRSF, kCSF + 1) = Cells(kR + 4, kCc + 7)  '--- copie la sortie en Sortie Finale
            nSF = nSF + 1
            kRSF = kRSF + 1
        End If
    Next kR
    Range("Z:Z").ClearContents                          '--- efface toute la colonne Z (sorties calandres)
    '---sorties séchoirs
    For kR = 4 To kRsFin Step 6                         '--- 4: première ligne produit en premier séchoir
        If Cells(kR, kCs + 6) = "" Then
            '--- rien, machine vide
        Else
            If [B8] >= Cells(kR + 4, kCs + 6) Then             '--- si l'heure est atteinte
                '--- mettre le produit en sortie, en déplaçant toute la file vers la droite
                Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 6)).Copy
                Cells(kR, kCs + 2).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
                [B8].Select
                '--- vider première colonne file approvisionnement
                Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 1)).ClearContents
            End If
        End If
    Next kR
    '--- envoyer sorties séchoirs vers calandreuses
    For kR = 4 To kRsFin Step 6                         '--- 4: première ligne produit en premier séchoir
        If Cells(kR, kCs + 7) <> "" Then
            'SelectionCalandreuse Cells(kR, kCs + 7)
        End If
    Next kR
    Range("R:R").ClearContents                          '--- efface toute la colonne R (sorties séchoirs)
    '---sorties tunnels
    For kR = 7 To kRtFin Step 6                         '--- 7: première ligne produit en premier tunnel
        '--- calcul de l'heure fin dans le tunnel (qui au début n'est pas rempli)
        hMax = WorksheetFunction.Max(Range(Cells(kR + 4, kCt + 1), Cells(kR + 4, kCt + 6)))
        If hMax = 0 Then
            '--- rien: tunnel vide
        ElseIf [B8] >= hMax Then                        '--- heure fin est atteinte
            '--- mettre le produit en sortie, en déplaçant toute la file vers la droite
            Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 6)).Copy
            Cells(kR, kCt + 2).PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            [B8].Select
            '--- vider première colonne file approvisionnement
            Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 1)).ClearContents
            '--- recalculer les heures fin
            For kC = kCt + 2 To kCt + 6
                If Cells(kR + 2, kC) <> "" Then
                    Cells(kR + 2, kC) = Cells(kR + 4, kC)
                    Cells(kR + 4, kC) = Cells(kR + 2, kC) + Cells(kR + 3, kC)
                End If
            Next kC
        End If
    Next kR
    '--- envoyer sorties tunnels vers séchoirs
    For kR = 7 To kRtFin Step 6                         '--- 7: première ligne produit en premier tunnel
        If Cells(kR, kCt + 7) <> "" Then
            'SelectionSechoir Cells(kR, kCt + 7)
        End If
    Next kR
    Range("J:J").ClearContents                          '--- efface toute la colonne R (sorties séchoirs)
    '--- envoyer produit dans tunnel
    For kR = 7 To kRtFin Step 6
        If Cells(kRFP, 1) <> "" Then                    '--- il y a un produit
            If Cells(kR, kCt + 1) = "" Then
               Cells(kR, kCt + 1) = Cells(kRFP, 1)                 '--- code famille produit suivant liste en colonne 1 ''c'est ici ou il faut intégré le cadencement
                Cells(kR + 1, kCt + 1) = [B1]                       '--- quantité
                Cells(kR + 3, kCt + 1) = (100 / 6) / 24 / 60        '--- temps de traitement (durée cycle): 100minutes/6phases
                Cells(kR + 2, kCt + 1) = [B8]                       '--- heure d'entrée = heure simulation
                Cells(kR + 4, kCt + 1) = Cells(kR + 2, kCt + 1) + Cells(kR + 3, kCt + 1)    '--- heure fin
                Cells(kRFP, 3) = [B8]                               '--- heure envoi en 3e colonne liste produits à traiter
                nFP = nFP + 1
                kRFP = kRFP + 1
            End If
        End If
    Next kR
End Sub

voila l'image ci dessous ca ta des question n'hésite pas stp

merci

Bonjour,

d'abord en regardant ton code, ces 3 définitions ne sont pas cohérentes avec leur commentaire

    kRcFin = Range("S" & Rows.Count).End(xlUp).Row  '--- dernière ligne colonne Z, sorties caladreuses
    kRsFin = Range("K" & Rows.Count).End(xlUp).Row  '--- dernière ligne colonne R, sorties séchoirs
    kRtFin = Range("C" & Rows.Count).End(xlUp).Row  '--- dernière ligne colonne J, sorties tunnels

ensuite quelle est exactement la partie de ton code posant problème. Est-ce celui-ci ?

Par ailleurs, Il serait bon d'indiquer à quoi correspond la variable "KR".

    '--- envoyer produit dans tunnel
    For kR = 7 To kRtFin Step 6
        If Cells(kRFP, 1) <> "" Then                    '--- il y a un produit
            If Cells(kR, kCt + 1) = "" Then
               Cells(kR, kCt + 1) = Cells(kRFP, 1)                 '--- code famille produit suivant liste en colonne 1 ''c'est ici ou il faut intégré le cadencement
                Cells(kR + 1, kCt + 1) = [B1]                       '--- quantité
                Cells(kR + 3, kCt + 1) = (100 / 6) / 24 / 60        '--- temps de traitement (durée cycle): 100minutes/6phases
                Cells(kR + 2, kCt + 1) = [B8]                       '--- heure d'entrée = heure simulation
                Cells(kR + 4, kCt + 1) = Cells(kR + 2, kCt + 1) + Cells(kR + 3, kCt + 1)    '--- heure fin
                Cells(kRFP, 3) = [B8]                               '--- heure envoi en 3e colonne liste produits à traiter
                nFP = nFP + 1
                kRFP = kRFP + 1
            End If
        End If
    Next kR

en faite la premiére ligne des différents machines est S;K;C et le KRcFin; KRsFin; KRtFin c'est les dérniére lignes

c'est juste ce que j'ai dans le code regarde l'image et tu va comprendre

pour la 2eme question

KR c'est la variable qui pointe sur la premiére Famille en colonne A ligne 21

moi la partis que je veux modifier c'est la partis alimentation du tunel parceque en faite maintenant les code familles sont envoyer au tunel en suivant l'ordre de la liste des code famille alors que moi je veux lui imposé un ordonnacenet en colonne G comme tu pourra voir sur l'image et lui dire si par exemple j'ai Plat2 qui doit passer en premier il va me chercher dans la colonne A le code famille qui a plat2 et le lancer dans le tunel

voila maintenant le code que j'ai pour la partis lancement de passe dans le tunel

Option Explicit
Option Base 1           '--- la numérotation des tableaux (arrays) commence à 1

'--- 99 familles de produit
Dim FPcode(99) As String        '--- tous les codes DOIVENT se terminer par 2 chiffres 01, 02, ... 99
Dim FPnom(99) As String
Dim FPSechTyp(99) As String
Dim FPSechTemps(99) As Single
Dim FPCalTyp(99) As String
Dim FPCalTemps(99) As Single
'---
Dim kCSF As Long    '--- n° colonne Sortie Finale
Dim kRSF As Long    '--- n° ligne Sortie Finale
Dim kCt As Long     '--- n° colonne tunnels
Dim kCs As Long     '--- n° colonne séchoirs
Dim kCc As Long     '--- n° colonne calandreuses
Dim kRFP As Long    '--- n° ligne famille produit
Dim kRtFin As Long  '--- n° dernière ligne tunnel
Dim kRsFin As Long  '--- n° dernière ligne séchoirs
Dim kRcFin As Long  '--- n° dernière ligne calandres
Dim nFP As Long     '--- nombre de produits à traiter
Dim nSF As Long     '--- nombre de produits en sortie finale
Private Sub InitialiserFP()                                 '--- FP Famile Produit
    Dim wshD As Worksheet, kR As Long, i As Long, t As Variant
    Set wshD = ActiveWorkbook.Worksheets("Donnees")
    kR = 2                                              '--- commencer ligne 2
    With wshD
        While Len(.Cells(kR, 1)) > 0
            i = Val(Right(.Cells(kR, 11), 2))
            FPnom(i) = .Cells(kR, 1)                    '--- nom
            FPcode(i) = .Cells(kR, 11)                  '--- code
            FPSechTyp(i) = .Cells(kR, 6)                '--- type séchoir
            t = .Cells(kR, 7)
            t = Hour(t) * 24 + Minute(t)
            FPSechTemps(i) = t / 1440                   '--- cycle séchoir (conversion heures en secondes)
            FPCalTyp(i) = .Cells(kR, 8)                 '--- type calandre
            FPCalTemps(i) = FPSechTemps(i)              '--- cycle calandre = cycle sechoir --- à modifier
            kR = kR + 1
            'Debug.Print FPcode(i), FPSechTemps(i)
        Wend
    End With
    Set wshD = Nothing
End Sub

Sub Simulation()
    Dim dH As String, hFin As Single
    '--- initialisatoon
    InitialiserFP
    nFP = 0
    nSF = 0
    kCt = [C1].Column               '--- colonne Machine Tunnel
    kCs = [K1].Column               '--- colonne Machine Séchoirs
    kCc = [S1].Column               '--- colonne Machine Calandres
    kCSF = [AA1].Column             '--- colonne Sortie Finale
    kRcFin = Range("S" & Rows.Count).End(xlUp).Row  '--- dernière ligne colonne Z, sorties caladreuses
    kRsFin = Range("K" & Rows.Count).End(xlUp).Row  '--- dernière ligne colonne R, sorties séchoirs
    kRtFin = Range("C" & Rows.Count).End(xlUp).Row  '--- dernière ligne colonne J, sorties tunnels
    kRSF = 4                        '--- première ligne Sortie Finale
    kRFP = 21                       '--- première ligne famille produit
    [B8] = [B6] + 1                 '--- 1 jour  ======================= simulation sur 1 jour (24 heures)
    hFin = [B8]                     '--- heure fin
    dH = 1 / 24 / 60                '--- 1 minute --- pas de temps de la simulation
                                    '---              1 minute = 1 jour / 24 heures / 60 minutes
    [B8] = [B6]                     '--- B6 heure actuelle = B5 heure départ
    '--- boucle de simulation
    While [B8] <= hFin
        SimulerProduit
        [B8] = [B8] + dH
        'If MsgBox("Simuler minute " & Format([B8], "hh\h mm\'"), vbYesNo + vbDefaultButton1, "Continuer") = vbNo Then Exit Sub
        DoEvents
        If nSF = nFP Then
            MsgBox "Tous les produits ont été traités"
            Exit Sub
        End If
    Wend
End Sub

Sub SimulerProduit()
    Dim kR As Long, hMax As Single, kC As Long

    '--- sortir les produits traités de leurs machines
    '--- sorties calandreuse

    For kR = 4 To kRcFin Step 6                         '--- 4: première ligne produit en première calandre
        If Cells(kR, kCc + 6) = "" Then
            '--- rien, machine vide
        Else
            If [B8] >= Cells(kR + 4, kCc + 6) Then             '--- si l'heure est atteinte
                '--- mettre le produit en sortie, en déplaçant toute la file vers la droite
                Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 6)).Copy
                Cells(kR, kCc + 2).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
                [B8].Select
                '--- vider première colonne file approvisionnement
                Range(Cells(kR, kCc + 1), Cells(kR + 4, kCc + 1)).ClearContents
            End If
        End If
    Next kR
    '--- envoyer sorties calandreuses vers sortie finale
    For kR = 4 To kRcFin Step 6                         '--- 4: première ligne produit en première calandre
        If Cells(kR, kCc + 7) <> "" Then
            Cells(kRSF, kCSF) = Cells(kR, kCc + 7)      '--- copie la sortie en Sortie Finale
            Cells(kRSF, kCSF + 1) = Cells(kR + 4, kCc + 7)  '--- copie la sortie en Sortie Finale
            nSF = nSF + 1
            kRSF = kRSF + 1
        End If
    Next kR
    Range("Z:Z").ClearContents                          '--- efface toute la colonne Z (sorties calandres)
    '---sorties séchoirs
    For kR = 4 To kRsFin Step 6                         '--- 4: première ligne produit en premier séchoir
        If Cells(kR, kCs + 6) = "" Then
            '--- rien, machine vide
        Else
            If [B8] >= Cells(kR + 4, kCs + 6) Then             '--- si l'heure est atteinte
                '--- mettre le produit en sortie, en déplaçant toute la file vers la droite
                Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 6)).Copy
                Cells(kR, kCs + 2).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
                [B8].Select
                '--- vider première colonne file approvisionnement
                Range(Cells(kR, kCs + 1), Cells(kR + 4, kCs + 1)).ClearContents
            End If
        End If
    Next kR
    '--- envoyer sorties séchoirs vers calandreuses
    For kR = 4 To kRsFin Step 6                         '--- 4: première ligne produit en premier séchoir
        If Cells(kR, kCs + 7) <> "" Then
            SelectionCalandreuse Cells(kR, kCs + 7)
        End If
    Next kR
    Range("R:R").ClearContents                          '--- efface toute la colonne R (sorties séchoirs)
    '---sorties tunnels
    For kR = 7 To kRtFin Step 6                         '--- 7: première ligne produit en premier tunnel
        '--- calcul de l'heure fin dans le tunnel (qui au début n'est pas rempli)
        hMax = WorksheetFunction.Max(Range(Cells(kR + 4, kCt + 1), Cells(kR + 4, kCt + 6)))
        If hMax = 0 Then
            '--- rien: tunnel vide
        ElseIf [B8] >= hMax Then                        '--- heure fin est atteinte
            '--- mettre le produit en sortie, en déplaçant toute la file vers la droite
            Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 6)).Copy
            Cells(kR, kCt + 2).PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            [B8].Select
            '--- vider première colonne file approvisionnement
            Range(Cells(kR, kCt + 1), Cells(kR + 4, kCt + 1)).ClearContents
            '--- recalculer les heures fin
            For kC = kCt + 2 To kCt + 6
                If Cells(kR + 2, kC) <> "" Then
                    Cells(kR + 2, kC) = Cells(kR + 4, kC)
                    Cells(kR + 4, kC) = Cells(kR + 2, kC) + Cells(kR + 3, kC)
                End If
            Next kC
        End If
    Next kR
    '--- envoyer sorties tunnels vers séchoirs
    For kR = 7 To kRtFin Step 6                         '--- 7: première ligne produit en premier tunnel
        If Cells(kR, kCt + 7) <> "" Then
            SelectionSechoir Cells(kR, kCt + 7)
        End If
    Next kR
    Range("J:J").ClearContents                          '--- efface toute la colonne R (sorties séchoirs)
    '--- envoyer produit dans tunnel
    For kR = 7 To kRtFin Step 6
        If Cells(kRFP, 1) <> "" Then                    '--- il y a un produit
            If Cells(kR, kCt + 1) = "" Then
                Cells(kR, kCt + 1) = Cells(kRFP, 1)                 '--- code famille produit suivant liste en colonne 1
                Cells(kR + 1, kCt + 1) = [B1]                       '--- quantité
                Cells(kR + 3, kCt + 1) = (100 / 6) / 24 / 60        '--- temps de traitement (durée cycle): 100minutes/6phases
                Cells(kR + 2, kCt + 1) = [B8]                       '--- heure d'entrée = heure simulation
                Cells(kR + 4, kCt + 1) = Cells(kR + 2, kCt + 1) + Cells(kR + 3, kCt + 1)    '--- heure fin
                Cells(kRFP, 3) = [B8]                               '--- heure envoi en 3e colonne liste produits à traiter
                nFP = nFP + 1
                kRFP = kRFP + 1
            End If
        End If
    Next kR
End Sub