XL 2019 Supprimer ou décaler une ligne lors d'un transfert de données d'un onglet à un autre via une macro

[Sod2]

Bonjour,

J'ai besoin de votre aide...

J'ai un bouton qui transfert les 3 première colonne de mon onglet GLOBAL (ce sont des métiers) en fonction de case coché dans les colonnes 4 à 7 ( des entreprises qui vont de 1 à 4) ( Colonnes D,E,F,G).

Cela me sert ensuite à faire des modifications sur chaque onglet pour un même métier (ils ont des primes différentes par exemples)

Le problème c'est que des fois je suis susceptible d'enlever ou de rajouter un métier ( et donc de coché ou de décocher une case) et c'est la ou cela me chamboule tout.

En effet cela me décale les caractéristiques (primes par exemple) soit vers le haut ou soit vers le bas en fonction d'un ajout ou d'une suppression dans les onglets des entreprises.

Cela est-il possible de faire en sorte que lorsque j'ajoute un métier pour une entreprise cela décale les cellules vers le bas du même nombre que de métier ajouté ? Pour les suppression il faudrait que cela supprime la ou les lignes concernées ? ( Il peut y avoir plusieurs ajout et plusieurs suppression)

En fait il faut que quoi qu'il arrive les numéro de la colonne A doivent correspondre aux numéros de la colonne D qui correspondent aux actions propre à chaque entreprise. (j'ai mis des numéros pour avoir en tête les actions propre, sinon avec les décalage cela chamboule tout)

J'espère que vous m'avez compris ... c'est pas forcement évident à expliquer.

Je vous joins mon fichier Excel.

Merci à gmd qui me l'avait fait d'ailleurs

Je vous remercie.

 

[st007]

Et si tu vides tes tableaux de destination avant de copier, ce sera irréversible tes colonnes f et g de tes onglets entreprise seront définitivement effacées.
A toi de voir

 

[Sod2]

Et si tu vides tes tableaux de destination avant de copier, ce sera irréversible tes colonnes f et g de tes onglets entreprise seront définitivement effacées.
A toi de voir

POUR LA SUPPRESSION De DONNEES QUI N'EXISTENT PLUS : Est ce que l'on pourrais faire un code qui dit " Si la colonne A de A6 à A100" ne contient pas une des valeurs de la colonne D de D6 à D100 (*on parle ici de numéro de ligne) alors on supprime les cases de la ligne correspondante de D à H (on parle de la ligne ou la valeur de D n'existe pas dans dans la colonne A ( et comme quand on supprime une case, cela fait remonter les autres ligne).

POUR L'AJOUT DE LIGNE : Est ce que l'on pourrais faire un code qui dit " Si on ajoute tant de ligne ( colonne de A à C) alors ont décale les lignes D à H vers le bas du nombre de ligne ajoutées ( Pour compter le nombre de lignes ajoutées ont calcul le nombre de cellule vide de la colonne D)

C'est possible ? Je sais pas si vous voyez ou je veux en venir.

Je vous remercie

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @Sod2
Essaie avec ce code :

Sub transfert()
     Const Ofst = 3
     Dim ShS As Worksheet, ShC As Worksheet
     Dim LoS As ListObject, LoC As ListObject, TbS, TbC
     Dim t(0 To 2)
'    Dim dS As New Scripting.Dictionary, dC As New Scripting.Dictionary   'Avec liaison anticipée (Microsoft Scripting Runtime en référence)
     Dim dS As Object, dC As Object                                       'Avec liason tardive
     Set dS = CreateObject("Scripting.Dictionary"): Set dC = CreateObject("Scripting.Dictionary") 'Avec liason tardive
     Set ShS = Feuil9: Set LoS = ShS.ListObjects(1)
     If LoS.ListRows.Count = 0 Then Exit Sub
     
     TbS = LoS.DataBodyRange
     Entreprises = LoS.HeaderRowRange.Offset(0, Ofst).Resize(1, 4)
     'Boucle sur les entreprises
     For e = 1 To UBound(Entreprises, 2)
          'Objets feuille et tableau concernés
          Set ShC = ThisWorkbook.Worksheets(Entreprises(1, e)): Set LoC = ShC.ListObjects(1)
          'Dico source pour cette entreprise (case entreprise cochée)
          dS.RemoveAll
          For i = 1 To UBound(TbS, 1)
               If TbS(i, e + Ofst) <> "" Then dS(TbS(i, 2)) = TbS(i, 1) & Chr(9) & TbS(i, 2) & Chr(9) & TbS(i, 3)
          Next i
          'Valeurs contenues dans le tableau cible
          TbC = LoC.DataBodyRange
          'Dico cible (métiers contenus dans le tableau cible)
          dC.RemoveAll
          For i = UBound(TbC, 1) To 1 Step -1
               If TbC(i, 2) <> "" Then dC(TbC(i, 2)) = i
          Next i
          'Suppression ou mise à jour des lignes existant dans le tableau cible
          For Each m In dC.Keys
               If Not dS.Exists(m) Then
                    LoC.ListRows(dC(m)).Delete
               Else
                    s = Split(dS(m), Chr(9))
                    t(0) = CDbl(s(0)): t(1) = s(1): t(2) = CDbl(s(2))
                    LoC.ListRows(dC(m)).Range.Range("A1:C1").Value = t
               End If
          Next m
          'Rajout des nouvelles lignes dans le tableau cible et tri sur les N°
          For Each m In dS.Keys
               If Not dC.Exists(m) Then
                    s = Split(dS(m), Chr(9))
                    t(0) = CDbl(s(0)): t(1) = s(1): t(2) = CDbl(s(2)) 'Conversion des nombre sous forme de texte en nombre
                    With LoC
                         .HeaderRowRange.Offset(.ListRows.Count + 1).Resize(1, 3) = t 'Ajout de la ligne
                         'Tri
                         With .Sort
                              .SortFields.Clear
                              .SortFields.Add Key:=LoC.ListColumns(1).Range, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
                              .Header = xlYes
                              .MatchCase = False
                              .Orientation = xlTopToBottom
                              .Apply
                         End With
                    End With
               End If
          Next m
     Next e
End Sub

Voir le fichier exemple joint.
La comparaison est faite sur les métiers et non sur les numéros, mais c'est facile à changer.
Un tri sur les n° est effectué après ajout/suppression des lignes.
J'ai modifié tes mises en forme conditionnelles

Amicalement
Alain
Modif : Commentaires et version compatible avec Office 2007 (.SortFields.Add à la place de.SortFields.Add2)

 

[Sod2]

Bonjour à toutes & à tous, bonjour @Sod2
Essaie avec ce code :

Sub transfert()
     Const Ofst = 3
     Dim ShS As Worksheet, ShC As Worksheet
     Dim LoS As ListObject, LoC As ListObject, TbS, TbC
     Dim t(0 To 2)
'    Dim dS As New Scripting.Dictionary, dC As New Scripting.Dictionary   'Avec liaison anticipée (Microsoft Scripting Runtime en référence)
     Dim dS As Object, dC As Object                                       'Avec liason tardive
     Set dS = CreateObject("Scripting.Dictionary"): Set dC = CreateObject("Scripting.Dictionary") 'Avec liason tardive
     Set ShS = Feuil9: Set LoS = ShS.ListObjects(1)
     If LoS.ListRows.Count = 0 Then Exit Sub
    
     TbS = LoS.DataBodyRange
     Entreprises = LoS.HeaderRowRange.Offset(0, Ofst).Resize(1, 4)
     'Boucle sur les entreprises
     For e = 1 To UBound(Entreprises, 2)
          'Objets feuille et tableau concernés
          Set ShC = ThisWorkbook.Worksheets(Entreprises(1, e)): Set LoC = ShC.ListObjects(1)
          'Dico source pour cette entreprise (case entreprise cochée)
          dS.RemoveAll
          For i = 1 To UBound(TbS, 1)
               If TbS(i, e + Ofst) <> "" Then dS(TbS(i, 2)) = TbS(i, 1) & Chr(9) & TbS(i, 2) & Chr(9) & TbS(i, 3)
          Next i
          'Valeurs contenues dans le tableau cible
          TbC = LoC.DataBodyRange
          'Dico cible (métiers contenus dans le tableau cible)
          dC.RemoveAll
          For i = UBound(TbC, 1) To 1 Step -1
               If TbC(i, 2) <> "" Then dC(TbC(i, 2)) = i
          Next i
          'Suppression ou mise à jour des lignes existant dans le tableau cible
          For Each m In dC.Keys
               If Not dS.Exists(m) Then
                    LoC.ListRows(dC(m)).Delete
               Else
                    s = Split(dS(m), Chr(9))
                    t(0) = CDbl(s(0)): t(1) = s(1): t(2) = CDbl(s(2))
                    LoC.ListRows(dC(m)).Range.Range("A1:C1").Value = t
               End If
          Next m
         'Rajout des nouvelles lignes dans le tableau cible et tri sur les N°
          For Each m In dS.Keys
               If Not dC.Exists(m) Then
                    s = Split(dS(m), Chr(9))
                    t(0) = CDbl(s(0)): t(1) = s(1): t(2) = CDbl(s(2)) 'Conversion des nombre sous forme de texte en nombre
                    With LoC
                         .HeaderRowRange.Offset(.ListRows.Count + 1).Resize(1, 3) = t 'Ajout de la ligne
                         'Tri
                         With .Sort
                              .SortFields.Clear
                              .SortFields.Add Key:=LoC.ListColumns(1).Range, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
                              .Header = xlYes
                              .MatchCase = False
                              .Orientation = xlTopToBottom
                              .Apply
                         End With
                    End With
               End If
          Next m
     Next e
End Sub

Voir le fichier exemple joint.
La comparaison est faite sur les métiers et non sur les numéros, mais c'est facile à changer.
Un tri sur les n° est effectué après ajout/suppression des lignes.
J'ai modifié tes mises en forme conditionnelles

Amicalement
Alain
Modif : Commentaires et version compatible avec Office 2007 (.SortFields.Add à la place de.SortFields.Add2)

Bonjour @AtTheOne

Merci c'est exactement ce que je voulais !

Cependant si je veux faire des modif sur le nombre de colonne à transférer pour le global (A6 à F) ou de colonnes à garder pour les entreprises (G6 à AC) quels sont les termes que je dois modifier ?

Et si j'ai plus d'onglets "Entreprises" que 4 (j'en ai 8) avec des noms différents, quels sont les termes que je dois modifier ?

je pensais pouvoir le faire mais c'est plus difficile que prévu !

Je vous remercie

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @Sod2

J'ai légèrement modifier le code pour te faciliter la vie.

Cependant si je veux faire des modif sur le nombre de colonne à transférer pour le global (A6 à F) ou de colonnes à garder pour les entreprises (G6 à AC) quels sont les termes que je dois modifier ?

Pour le premier point Il te faut modifier la constante publique Col_To_Transfert déclarée dans le module M00_Public :

Ici elle vaut 5, tu la passes à 6 pour transférer les colonnes A à F.

Pour le deuxième point tu dois étirer tes tableaux structurés jusqu'à la colonne AC :

Et si j'ai plus d'onglets "Entreprises" que 4 (j'en ai 8) avec des noms différents, quels sont les termes que je dois modifier ?

Là tu n'as qu'à indiquer le N° de la première colonne contenant le nom d'une entreprise dans la constante Col_Entreprise1 du module M00_Public :

Ici elle vaut 6.
(J'ai mis cette variable au cas où entre les colonnes à transférer et la 1ère colonne d'entreprise il y ait des colonnes à ignorer.)
Toutes les colonnes suivantes du tableau Global sont considérées comme des colonnes Entreprise.
Contrainte : les noms des entreprises dans les colonnes du tableau Global doivent être les mêmes que ceux des onglets associés.

(Voir les macros dans le fichier modifié joint.)
Amicalement
Alain

 

[Sod2]

Bonjour à toutes & à tous, bonjour @Sod2

J'ai légèrement modifier le code pour te faciliter la vie.

Pour le premier point Il te faut modifier la constante publique Col_To_Transfert déclarée dans le module M00_Public :
Regarde la pièce jointe 1133910

Regarde la pièce jointe 1133911
Ici elle vaut 5, tu la passes à 6 pour transférer les colonnes A à F.

Pour le deuxième point tu dois étirer tes tableaux structurés jusqu'à la colonne AC :
Regarde la pièce jointe 1133916




Là tu n'as qu'à indiquer le N° de la première colonne contenant le nom d'une entreprise dans la constante Col_Entreprise1 du module M00_Public :
Regarde la pièce jointe 1133928Ici elle vaut 6.
(J'ai mis cette variable au cas où entre les colonnes à transférer et la 1ère colonne d'entreprise il y ait des colonnes à ignorer.)
Toutes les colonnes suivantes du tableau Global sont considérées comme des colonnes Entreprise.
Contrainte : les noms des entreprises dans les colonnes du tableau Global doivent être les mêmes que ceux des onglets associés.

(Voir les macros dans le fichier modifié joint.)
Amicalement
Alain

Je vous remercie, çà marche niquel !

Vraiment merci merci beaucoup !