Microsoft 365 VBA pour copier une une des données d'une ligne à une autre

[salma_hayek]

Bonjour tout le monde,

Je m'explique j'ai des données dans la feuille EVENTS qui doivent être copiées dans des lignes spécifiques de la feuille contract FU suivant qu'elle option a été choisie dans la colonne I de la feuille EVENTS. Pour ce faire j'ai mis en place cette VBA (ci-dessous). Cependant quand je sélectionne plusieurs fois l'opiton dans la colonne I de la feuille EVENTS, la ligne respective vient supprimer et remplacer la ligne précédemment coller au lieu de venir s(ajouter en dessous de cette dernière. Quelqu'un peut il m'aide svp?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsEvent As Worksheet
    Dim wsContractFU As Worksheet
    Dim copyRange As Range
    Dim destinationRange As Range
    Dim destinationRange2 As Range
    Dim lastRow As Long
    Dim selectedOption As Range
    Dim option1_rows As New Collection
    Dim option2_rows As New Collection
    
    ' Définir les feuilles de travail
    Set wsEvent = ThisWorkbook.Sheets("EVENTS")
    Set wsContractFU = ThisWorkbook.Sheets("Contract FU")
    
    ' Définir les plages de destination dans la feuille "Contract FU"
    Set destinationRange = wsContractFU.Range("B68:K89") ' Plage pour Option1
    Set destinationRange2 = wsContractFU.Range("B95:K115") ' Plage pour Option2
    
    ' Vérifier si le changement concerne la colonne "I" de la feuille "Event"
    If Not Intersect(Target, wsEvent.Columns("I:I")) Is Nothing Then
        Application.EnableEvents = False ' Désactiver les événements pour éviter une boucle infinie
        ' Vérifier la valeur modifiée dans la colonne "I"
        For Each selectedOption In Target.Cells
            If Not IsEmpty(selectedOption.Value) Then
                ' Déterminer la plage à copier (de J à T)
                lastRow = wsEvent.Cells(wsEvent.Rows.Count, "I").End(xlUp).Row
                Set copyRange = wsEvent.Range(wsEvent.Cells(selectedOption.Row, "J"), wsEvent.Cells(selectedOption.Row, "T"))
                
                ' Copier la ligne dans la plage de destination en fonction de l'option sélectionnée
                If selectedOption.Value = "option 1" Then
                    option1_rows.Add copyRange, CStr(selectedOption.Row)
                ElseIf selectedOption.Value = "option 2" Then
                    option2_rows.Add copyRange, CStr(selectedOption.Row)
                End If
            End If
        Next selectedOption
        
        ' Copier toutes les lignes correspondantes dans les plages de destination
        For Each copyRange In option1_rows
            copyRange.Copy destinationRange
        Next copyRange
        For Each copyRange In option2_rows
            copyRange.Copy destinationRange2
        Next copyRange
        
        Application.EnableEvents = True ' Réactiver les événements
    End If

 

[Oneida]

Bonjour,
Avec un fichier serait plus simple pour vous aider

 

[crocrocro]

Bonjour ,

Bonjour,
Avec un fichier serait plus simple pour vous aider

c'est sûr !
après une simple lecture du code de la macro, une possible explication :
En début de macro, votre code

    ' Définir les plages de destination dans la feuille "Contract FU"
    Set destinationRange = wsContractFU.Range("B68:K89") ' Plage pour Option1
    Set destinationRange2 = wsContractFU.Range("B95:K115") ' Plage pour Option2

puis pour la copie, votre code

        ' Copier toutes les lignes correspondantes dans les plages de destination
        For Each copyRange In option1_rows
            copyRange.Copy destinationRange
        Next copyRange
        For Each copyRange In option2_rows
            copyRange.Copy destinationRange2
        Next copyRange

à chaque boucle on vient copier à partir de la 1ère ligne de destinationRange, donc on écrase les valeurs précédentes !
il faut réévaluer destinationRange à chaque tour de boucle, c'est à dire, la décaler vers le bas de copyrange.count