XL 2016 vba pour différer une cellule d'une feuille dans une autre feuille

litchoutsou

XLDnaute Nouveau
Supporter XLD
Bonjour à tous et merci de votre aide voici mon problème

En feuille 1 et dans la colonne C j’ai des objets de la ligne 4 à 350 et dans D4 il y a un nom (liste déroulante) et en E4 date de sortie et en F4 date de Rentrée
D4 de la feuille 1 doit aller s’inscrire sur la feuille 2 en A6
E4 de la feuille 1 doit aller s’inscrire sur la feuille 2 en A7
F4 de la feuille 1 doit aller s’inscrire sur la feuille 2 en B7 ET surtout ne pas s’effacer lorsque l’objet 1 ressort une deuxième fois , le nom va changer et les dates vont changer

lorsque l'objet 1 ressort une deuxième fois
D4 de la feuille 1 doit aller s’inscrire sur la feuille 2 en A8
E4 de la feuille 1 doit aller s’inscrire sur la feuille 2 en A9
F4 de la feuille 1 doit aller s’inscrire sur la feuille 2 en B9 et ne pas s’effacer lors de la prochaine sortie
Et ainsi de suite pour tous les objets

je m’excuse si je m’exprime mal mais je ne connais pas trop Excel
 

Pièces jointes

  • Classeur objets .xlsm
    24.1 KB · Affichages: 6

Robert

XLDnaute Barbatruc
Essaie comme ça :
VB:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim NUM As Integer 'déclare la variable NUM (Numéro)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim LI As Integer 'déclare la variable LI (LIgne)

Set OS = Worksheets("Feuil1") 'définit l'onglet source OS
DL = OS.Cells(Application.Rows.Count, "D").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne D de l'onglet source
For I = 4 To DL 'boucle sur toutes les lignes I de 4 à DL
    NUM = CInt(Split(OS.Cells(I, "C").Value, " ")(1)) 'récupère le numéro de l'objet (numéro après l'espace)
    If NUM < 6 Then Set OD = Worksheets("Feuil2") Else Set OD = Worksheets("Feuil" & (NUM \ 5) + 2) 'définit l'onglet destination en fonction du numéro NUM
    COL = IIf(NUM < 6, 2 * NUM - 1, 2 * (NUM Mod 5) - 1) 'définit l colonne COL en fonction du numéro NUM
    LI = OD.Cells(Application.Rows.Count, COL).End(xlUp).Row + 1 'définit la première ligne vide LI de la colonne COL de l'onglet OD
    OD.Cells(LI, COL).Value = OS.Cells(I, "D") 'renvoie la valeur de la cellule de la boucle en colonne D dans la cellule ligne LI colonne COL de l'onglet OD
    OD.Cells(LI + 1, COL).Value = OS.Cells(I, "E") 'renvoie la valeur de la cellule de la boucle en colonne E dans la cellule ligne LI + 1 colonne COL de l'onglet OD
    OD.Cells(LI + 1, COL + 1).Value = OS.Cells(I, "F") 'renvoie la valeur de la cellule de la boucle en colonne F dans la cellule ligne LI + 1 colonne COL +1 de l'onglet OD
Next I 'prochaine ligne de la boucle
End Sub
 

Robert

XLDnaute Barbatruc
Ou plutôt comme ça :
VB:
Sub Macro2()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim NUM As Integer 'déclare la variable NUM (Numéro)
Dim R As Range 'déclare la variable R (Recherche)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim TEST As Boolean 'déclare la variable TEST

Set OS = Worksheets("Feuil1") 'définit l'onglet source OS
DL = OS.Cells(Application.Rows.Count, "D").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne D de l'onglet source
For I = 4 To DL 'boucle sur toutes les lignes I de 4 à DL
    NUM = Split(OS.Cells(I, "C").Value, " ")(1) 'récupère le numéro de l'objet (numéro après l'espace)
    For J = 2 To Sheets.Count 'boucle sur tous les onglets J du second au dernier
        Set R = Worksheets(J).Rows(5).Find(NUM, , xlValues, xlWhole) 'définit la recherche R (recherche la valeur entière du  numéro NUM dans la ligne 5 de l'onglet J de la boucle)
        If Not R Is Nothing Then 'condition : s'il existe au moins un occurrence trouvée
            Set OD = Worksheets(J) 'définit l'onglet destination OD de la première occurrence trouvée
            COL = R.Column - 1 'définit la colonne COL
            TEST = True 'définit la variable TEST
            Exit For 'sort de la boucle
        End If 'fin de la condition
    Next J 'prochain onglet de la boucle
    If TEST = False Then 's=i TEST est [Faux]
        MsgBox Cells(I, "C").Value & " est introuvable !" 'message
    Else 'sinon
        LI = OD.Cells(Application.Rows.Count, COL).End(xlUp).Row + 1 'définit la première ligne vide LI de la colonne COL de l'onglet OD
        OD.Cells(LI, COL).Value = OS.Cells(I, "D") 'renvoie la valeur de la cellule de la boucle en colonne D dans la cellule ligne LI colonne COL de l'onglet OD
        OD.Cells(LI + 1, COL).Value = OS.Cells(I, "E") 'renvoie la valeur de la cellule de la boucle en colonne E dans la cellule ligne LI + 1 colonne COL de l'onglet OD
        OD.Cells(LI + 1, COL + 1).Value = OS.Cells(I, "F") 'renvoie la valeur de la cellule de la boucle en colonne F dans la cellule ligne LI + 1 colonne COL +1 de l'onglet OD
    End If
Next I 'prochaine ligne de la boucle
End Sub
 

Robert

XLDnaute Barbatruc
Bonjour Litchoutsou, bonjour le forum,

Voilà ce que je te propose, quand une ligne a été traitée un X est écrit dans la colonne G. Le code ne traite que les ligne ne contenant pas le X en colonne G.
Le code :

VB:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim NUM As Integer 'déclare la variable NUM (Numéro)
Dim R As Range 'déclare la variable R (Recherche)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim TEST As Boolean 'déclare la variable TEST

Set OS = Worksheets("Feuil1") 'définit l'onglet source OS
DL = OS.Cells(Application.Rows.Count, "D").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne D de l'onglet source
For I = 4 To DL 'boucle sur toutes les lignes I de 4 à DL
    If OS.Cells(I, "G").Value <> "X" Then 'condition 1 : si la cellule ligne I colonne G est différente de "X"
        NUM = Split(OS.Cells(I, "C").Value, " ")(1) 'récupère le numéro de l'objet (numéro après l'espace)
        For J = 2 To Sheets.Count 'boucle sur tous les onglets J du second au dernier
            Set R = Worksheets(J).Rows(5).Find(NUM, , xlValues, xlWhole) 'définit la recherche R (recherche la valeur entière du  numéro NUM dans la ligne 5 de l'onglet J de la boucle)
            If Not R Is Nothing Then 'condition : s'il existe au moins un occurrence trouvée
                Set OD = Worksheets(J) 'définit l'onglet destination OD de la première occurrence trouvée
                COL = R.Column - 1 'définit la colonne COL
                TEST = True 'définit la variable TEST
                Exit For 'sort de la boucle
            End If 'fin de la condition
        Next J 'prochain onglet de la boucle
        If TEST = False Then 'condition 2 : si TEST est [Faux]
            MsgBox Cells(I, "C").Value & " est introuvable !" 'message
        Else 'sinon
            OS.Cells(I, "G").Value = "X" 'ecrit "X" dans la cellule ligne I colonne G
            LI = OD.Cells(Application.Rows.Count, COL).End(xlUp).Row + 1 'définit la première ligne vide LI de la colonne COL de l'onglet OD
            OD.Cells(LI, COL).Value = OS.Cells(I, "D") 'renvoie la valeur de la cellule de la boucle en colonne D dans la cellule ligne LI colonne COL de l'onglet OD
            OD.Cells(LI + 1, COL).Value = OS.Cells(I, "E") 'renvoie la valeur de la cellule de la boucle en colonne E dans la cellule ligne LI + 1 colonne COL de l'onglet OD
            OD.Cells(LI + 1, COL + 1).Value = OS.Cells(I, "F") 'renvoie la valeur de la cellule de la boucle en colonne F dans la cellule ligne LI + 1 colonne COL +1 de l'onglet OD
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle
End Sub

Le fichier :
 

Pièces jointes

  • Litchoutsou_XD_01.xlsm
    42.1 KB · Affichages: 1

litchoutsou

XLDnaute Nouveau
Supporter XLD
MERCI Robert du travail que tu te donne pour m'aider, la cellule sortie et la cellule entrée ne sont pas traiter en même temps, il peut y avoir un intervalle entre 2 voir 4 mois, j'ai remarqué que si le rentre une date dans la cellule sortie et que je clic sur le bouton envoie c'est ok mais lorsque je rentre la date rentré et je clic sur le bouton envoie, la date sortie ne va pas se mettre dans la bonne cellule, mais le tout s'inscris plus bas,
 

Discussions similaires

Haut Bas