Supprimer ou décaler une ligne lors d'un transfert d'un onglet à un autre

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.

Bonjour,

Option Explicit

Sub MettreAJourLesEntreprises()

Dim NumeroTrouve As Boolean, ASupprimer As Boolean
Dim I As Integer, J As Integer, K As Integer, L As Integer, NbAjout As Integer, NbSup As Integer
Dim LigneEnt As ListRow
Dim GlobalNumero As Range, GlobalMetier As Range, GlobalCoef As Range, GlobalEntreprise As Range, GlobalEntete As Range
Dim EntNumero As Range, EntMetier As Range, EntCoef As Range

    Set GlobalNumero = Range("ONGLETGLOBAL[Numéro de Salarié]")
    Set GlobalMetier = Range("ONGLETGLOBAL[Métiers]")
    Set GlobalCoef = Range("ONGLETGLOBAL[Coef]")
    Set GlobalEntete = Range("ONGLETGLOBAL[#Headers]")

    NbAjout = 0: NbSup = 0

   For I = 1 To GlobalEntete.Count
       For J = 1 To Sheets.Count
           If GlobalEntete(I) = Sheets(J).Name Then

              Set GlobalEntreprise = Sheets("GLOBAL").ListObjects("ONGLETGLOBAL").ListColumns(GlobalEntete(I).Value).DataBodyRange

              With Sheets(J).ListObjects(1)
                   Set EntNumero = .ListColumns("NUM CONCERNÉ").DataBodyRange
                   Set EntMetier = .ListColumns("Métiers").DataBodyRange
                   Set EntCoef = .ListColumns("Coef").DataBodyRange
              End With

              ' Mise à jour et ajout
              For K = 1 To GlobalNumero.Count

                  If GlobalEntreprise(K) <> "" Then

                     NumeroTrouve = False
                     For L = 1 To EntNumero.Count
                         If GlobalNumero(K) = EntNumero(L) Then
                            EntMetier(L) = GlobalMetier(K)
                            EntCoef(L) = GlobalCoef(K)
                            NumeroTrouve = True
                         End If
                     Next L

                     If NumeroTrouve = False Then ' Nouveau métier pour l'entreprise
                        Set LigneEnt = Sheets(J).ListObjects(1).ListRows.Add
                        With LigneEnt
                             .Range(1, 4) = GlobalNumero(K)
                             .Range(1, 2) = GlobalMetier(K)
                             .Range(1, 3) = GlobalCoef(K)
                             NbAjout = NbAjout + 1
                        End With

                     End If

                  End If
              Next K

              ' Suppression
              For L = 1 To EntNumero.Count
                  NumeroTrouve = False
                  ASupprimer = False
                  For K = 1 To GlobalNumero.Count
                      If GlobalNumero(K) = EntNumero(L) Then
                         NumeroTrouve = True
                         If GlobalEntreprise(K) = "" Then ASupprimer = True
                      End If
                  Next K

                  If NumeroTrouve = False Or ASupprimer = True Then
                     EntNumero(L).EntireRow.Delete
                     NbSup = NbSup + 1
                  End If
              Next L

              Set EntNumero = Nothing: Set EntMetier = Nothing: Set EntCoef = Nothing

           End If

           Set GlobalEntreprise = Nothing

       Next J

   Next I

   MsgBox "Fin de mise à jour !" & Chr(10) & "- Ajouts : " & NbAjout & Chr(10) & "- Suppressions : " & NbSup, vbInformation

   Set GlobalNumero = Nothing: Set GlobalMetier = Nothing: Set GlobalCoef = Nothing: Set GlobalEntreprise = Nothing
   Set GlobalEntete = Nothing

End Sub
Rechercher des sujets similaires à "supprimer decaler ligne lors transfert onglet"