Ajouter ou supprimer des lignes en fonction de la valeur d'une cellule

Bonjour à tous,

Je me permets de vous solliciter car je suis débutant sur VBA et je suis dans une impasse.

Je souhaiterais que les lignes que j'insère dans la feuille "liste d'achats" s'insèrent automatiquement dans la feuille adéquate en fonction de la cellule "Type".

Et si jamais je change la valeur qui se trouve dans cette même cellule que la ligne qui a déjà été insérer dans la feuille se supprime et se réinsère dans la bonne feuille.

Je vous joins le fichier pour l'exemple.

Merci pour votre aide.

21essai.xlsm (37.38 Ko)

Salut

Voici une proposition :

Sub InsertLigne()
Dim FeuillesExport() As Variant
Dim FeuilleSource As Worksheet, FeuilleExport As Worksheet
Dim PlageInit() As Variant, PlageCompar() As Variant
Dim i As Long, j As Long, k As Long, x As Long, ComparOk As Long
Dim Destination As String
Dim PremLig As Long, DernLig As Long, DernLig2 As Long
Dim FeuilleExiste As Boolean, PresenceLigne As Boolean

    Set FeuilleSource = ThisWorkbook.Worksheets("LISTE ACHAT")
    FeuillesExport = Array("MP", "FOURN", "MARCH")
    For i = LBound(FeuillesExport) To UBound(FeuillesExport)
        FeuilleExiste = False
        For j = 1 To ThisWorkbook.Worksheets.Count
            If FeuillesExport(i) = ThisWorkbook.Worksheets(j).Name Then FeuilleExiste = True: Exit For
        Next j
        If FeuilleExiste = False Then MsgBox "La feuille """ & FeuillesExport(i) & """ n'existe pas dans le classeur.", vbCritical: Exit Sub
    Next i
    PremLig = 7
    DernLig = FeuilleSource.Range("A" & FeuilleSource.Rows.Count).End(xlUp).Row
    For i = PremLig To DernLig
        PlageInit = FeuilleSource.Range("A" & i & ":" & "F" & i).Value
        Destination = FeuilleSource.Range("G" & i)
        For j = LBound(FeuillesExport) To UBound(FeuillesExport)
            Set FeuilleExport = ThisWorkbook.Worksheets(FeuillesExport(j))
            DernLig2 = FeuilleExport.Range("A" & FeuilleExport.Rows.Count).End(xlUp).Row
            If DernLig2 < PremLig And FeuilleExport.Name = Destination Then
                FeuilleExport.Range("A" & DernLig2 + 1 & ":" & "F" & DernLig2 + 1) = PlageInit
            Else
                For k = PremLig To DernLig2
                    PlageCompar = FeuilleExport.Range("A" & i & ":" & "G" & i).Value
                    ComparOk = 0
                    PresenceLigne = False
                    For x = LBound(PlageCompar) To UBound(PlageCompar, 2)
                        If PlageCompar(1, x) = PlageInit(1, x) Then ComparOk = ComparOk + 1
                    Next x
                    If ComparOk = UBound(PlageCompar, 2) Then PresenceLigne = True
                    If PresenceLigne = True And FeuilleExport.Name <> Destination Then
                        FeuilleExport.Range("A" & k & ":" & "G" & k).Delete Shift:=xlUp
                    End If
                    If PresenceLigne = False And FeuilleExport.Name = Destination Then
                        FeuilleExport.Range("A" & DernLig2 + 1 & ":" & "G" & DernLig2 + 1) = PlageInit
                    End If
                Next k
            End If
        Next j
    Next i
End Sub

Si besoin je peux commenter le code !

Bonjour,

Je vous remercie pour la proposition que vous m'avez faite.

Serait-il possible de me commenter le code afin que je puisse comprendre comment il fonctionne.

J'ai tenté de le faire fonctionner en insérant des valeurs mais cela n'a pas fonctionné en me signalant "Erreur d'exécution 9".

Update :

J'ai tenté de réaliser une boucle afin d'ajouter une ligne vers les autres feuilles mais sans succès.

Pouvez-vous me dire ce qui ne va pas dans mon module_2.

9essai.xlsm (39.42 Ko)

Salut :)

Effectivement, j'ai fait deux erreurs, voilà le code corrigé et commenté (ne fait pas attention à la qualité rédactionnel des commentaires, j'ai fait ça à la rache ). J'ai pas bcp de temps donc j'ai pas vraiment eu le temps de faire des tests non plus.... Dit moi ce qu'il en est !

Sub InsertLigne()
Dim FeuillesExport() As Variant
Dim FeuilleSource As Worksheet, FeuilleExport As Worksheet
Dim PlageInit() As Variant, PlageCompar() As Variant
Dim i As Long, j As Long, k As Long, x As Long, ComparOk As Long
Dim Destination As String
Dim PremLig As Long, DernLig As Long, DernLig2 As Long
Dim FeuilleExiste As Boolean, PresenceLigne As Boolean

    Set FeuilleSource = ThisWorkbook.Worksheets("LISTE ACHAT") 'La vairaible FeuilleSource représente la feuille où se trouve les données de base
    FeuillesExport = Array("MP", "FOURN", "MARCH") 'Liste des feuilles d'exportation (là où ecrir les données)

    'La première partie du code est là pour s'assurer que les feuilles d'exportation existent
    For i = LBound(FeuillesExport) To UBound(FeuillesExport) 'Boucle sur les feuilles d'exportation
        FeuilleExiste = False 'La variable FeuilleExiste va nous servire de savoir si la feuille testée existe
        For j = 1 To ThisWorkbook.Worksheets.Count 'Boucle sur les feuilles du classeur
            'si le nom de la feuille du classeur = nom de la feuille d'expotation alors FeuilleExiste passe à l'état VRAI
            If FeuillesExport(i) = ThisWorkbook.Worksheets(j).Name Then FeuilleExiste = True: Exit For
        Next j
        'Si après le test la variable FeuilleExiste est restée à l'état FAUX alors message d'erreur
        If FeuilleExiste = False Then MsgBox "La feuille """ & FeuillesExport(i) & """ n'existe pas dans le classeur.", vbCritical: Exit Sub
    Next i

    'La deuxième partie du code est la pour idenfifier toutes les lignes sur la feuille source et de tester toutes les feuilles d'exportation.
    'Le teste va permettre de savoir si les données testées doivent être présentent sur cette feuille ou non
    'En fonction du cas de figure les données vont être ajoutées ou supprimées des feuilles d'exportation

    PremLig = 7 'Première ligne par défaut des listes de données sur les feuilles d'exportation
    DernLig = FeuilleSource.Range("A" & FeuilleSource.Rows.Count).End(xlUp).Row 'DernLig permet de recupérer le nméro dela dernière ligne non-vide de la feuille source
    For i = PremLig To DernLig 'Boucle sur toutes les lignes de la feuille source
        PlageInit = FeuilleSource.Range("A" & i & ":" & "F" & i).Value 'Plageinit représente l'ensemble des données de la première ligne de la feuille source
        Destination = FeuilleSource.Range("G" & i) 'Identification de la feuille où doit se trouver les données
        For j = LBound(FeuillesExport) To UBound(FeuillesExport) 'Boucle sur toutes les feuilles d'exportation
            Set FeuilleExport = ThisWorkbook.Worksheets(FeuillesExport(j)) 'Initialisation de la feuille d'exportation testée
            DernLig2 = FeuilleExport.Range("A" & FeuilleExport.Rows.Count).End(xlUp).Row 'Identification de la dernière ligne non-vide sur la feuille d'exportation
            If DernLig2 < PremLig And FeuilleExport.Name = Destination Then 'Si la feuille exportation est vide et si la feuille d'exportation est la feuille de destination alors :
                FeuilleExport.Range("A" & DernLig2 + 1 & ":" & "F" & DernLig2 + 1) = PlageInit 'Ecriture des données sur la feuille d'exportation
            Else 'Si la feuille d'exportation n'est pas vide
                For k = DernLig2 To PremLig Step -1 'Boucle sur toutes les lignes de la feuille d'exportation en partant de la dernière ligne
                    PlageCompar = FeuilleExport.Range("A" & k & ":" & "F" & k).Value 'La variable PlageCOmpar représente les données de la ligne sur la feuille dexportation
                    ComparOk = 0 'ComparOk va nous servire à compter les valeur similaire entre la plage de données initiale et la plage de données à comparer
                    PresenceLigne = False 'PrésenceLigne va nous permettre de savoir si les données sont identiques
                    For x = LBound(PlageCompar) To UBound(PlageCompar, 2) 'Boucle sur les données des plages
                        If PlageCompar(1, x) = PlageInit(1, x) Then ComparOk = ComparOk + 1 'Si pour chaque données egale ebtre les deux plage alors le compteur est incrementé de +1
                    Next x
                    If ComparOk = UBound(PlageCompar, 2) Then PresenceLigne = True 'Si le nombre de valeur identiques est égale aux nombre de données sur une plage alors la variable passse à VRAI
                    If PresenceLigne = True And FeuilleExport.Name <> Destination Then 'Si PresenceLigne=VRAI et si la feuille de destinbation n'est pas celle identifiée alors :
                        FeuilleExport.Range("A" & k & ":" & "G" & k).Delete Shift:=xlUp 'Suppression des données
                    End If
                Next k
                If PresenceLigne = False And FeuilleExport.Name = Destination Then 'Si présenceligne=FAUX et qu'il s'agit de la feuille de destination alors :
                    FeuilleExport.Range("A" & DernLig2 + 1 & ":" & "F" & DernLig2 + 1) = PlageInit 'Ecriture des données sur la dernnière ligne non-vide+1
                End If
            End If
        Next j
    Next i
End Sub

Bonjour,

Je vous remercie pour le code que vous m'avez corrigé et expliqué. Toutefois dès que je lance le programme il me réinsère en permanence les lignes qui ont déjà été insérer sur les autres feuilles. Y a t-il un moyen de bloquer cela?

Rechercher des sujets similaires à "ajouter supprimer lignes fonction valeur"