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