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

st007 à dit:

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

Cliquez pour agrandir...

AtTheOne à dit:

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

Enrichi (BBcode):

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)

Cliquez pour agrandir...

AtTheOne à dit:

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

Cliquez pour agrandir...