XL 2016 Comparaison de feuilles avec ajout / suppression de lignes

Denaizzz

XLDnaute Nouveau
Bonjour à tous.

Je pense que la question a déjà été posée 1000 fois, mais j’ai déjà tellement lu de post que je me suis perdu et je préfère repartir de zéro...

Dans un même fichier, j’ai une 1ère feuille nommé « Extraction ». Celle ci va chercher dans un autre fichier une liste des membres du personnel (issus de la RH et mis à jour en temps réels). Cette Extraction est faite via Power Query : Matricule, Nom, prénom, Ancienneté, site d’affectation.
Je souhaite ajouter d’autres colonnes mais avec Power Query, impossible.

J’ai donc, dans ce même fichier une Seconde feuille « Causeries » qui va me le permettre...

Je souhaite donc réaliser une macro en VBA qui va me permettre de comparer les deux feuilles (via le Num de Matricule en colonne A).

Si le num de Matricule disparaît de la feuille Extraction, on supprime toute la ligne correspondante sur la feuille Causeries.
Inversement, si un nouveau matricule apparaît dans la feuille Extraction, une nouvelle ligne contenant le matricule, le nom, prenom, etc... apparaît dans la feuille Causeries...


Merci d’avance, ça fait 1 semaine que je cherche ...

Cdt
Dénis
 

Denaizzz

XLDnaute Nouveau
VB:
Sub Actualisation()
Dim Der_Sc As Long
Dim F_Source As Worksheet
Dim der_Maj As Long
Dim F_Maj As Worksheet
Dim FC As Variant
Dim x As Long
Application.ScreenUpdating = False
Set F_Source = Sheets("Extraction")
Set F_Maj = Sheets("Causeries")
'si les ref sont en A dans les deux fichiers
Der_Sc = F_Source.Range("A" & F_Source.Rows.Count).End(xlUp).Row 'derni?re ligne du fichier source
der_Maj = F_Maj.Range("A" & F_Maj.Rows.Count).End(xlUp).Row 'derni?re ligne du fichier mis a jour
'les donn?es du fichier "maj" commencent en A2
'une colonne temporaire
FC = "=NB.SI(" & F_Source.Name & "'$A$2:$A$" & Der_Sc & ";A2)"
F_Maj.Range("F2" & der_Maj).FormulaLocal = FC
F_Maj.Range("F2" & der_Maj).AutoFill Destination:=F_Maj.Range("F2" & der_Maj), Type:=xlFillDefault
For x = der_Maj To 2 Step -1
  If F_Maj.Range("F" & x) = 0 Then
  F_Maj.Range("F" & x).EntireRow.Delete
End If
Next x
'on supprime la colonne temporaire
F_Maj.Columns("F:F").Delete
'on r'ecommence mais ? l'envers, pour ajouter les lignes
Der_Sc = F_Source.Range("A" & F_Source.Rows.Count).End(xlUp).Row
der_Maj = F_Maj.Range("A" & F_Maj.Rows.Count).End(xlUp).Row
'une colonne temporaire, cette fois au fichier source
FC = "=NB.SI(& F_Maj.Name & " '!$A$2:$A$" & der_Maj & ";A2)"
F_Source.Range("F2:F" & Der_Sc).FormulaLocal = FC
F_Source.Range("F2").AutoFill Destination:=F_Source.Range("F2:F" & Der_Sc), Type:=xlFillDefault
For x = Der_Sc To 2 Step -1
  If F_Source.Range("F" & x) = 0 Then
  F_Maj.Range("F" & der_Maj + 1, "P" & der_Maj + 1).Value = F_Source.Range("A" & x, "G" & x).Value
  der_Maj = F_Maj.Range("A" & F_Maj.Rows.Count).End(xlUp).Row
  End If
Next x
'on supprime la colonne temporaire
F_Source.Columns("F:F").Delete
Application.ScreenUpdating = True
End Sub

Pour info, j'étais sur cette base.
 

Fichiers joints

Dernière édition:

zebanx

XLDnaute Impliqué
Bonjour Denaizzz

En passant par un tableau et une private sub, ça à l'air de fonctionner.
Il faut cependant que je fasse une demande car la mise à jour se lance sur la colonne "F" de la feuille "E" (pour extraction), ce qui ne convient pas.
Je complèterai après retour sur ma demande.

Mais dans l'idée, ça doit ressembler à ce que vous rechercher

@+
zebanx
 

Fichiers joints

Denaizzz

XLDnaute Nouveau
Bonjour !
Ouii !
On s'en approche fortement !!
Un grand merci :

Quelques soucis à résoudre en effet, mais dans l'idée générale c'est ça.
J'ai tenté de modifier le code pour corriger et adapter mais ce que je fais ne fonctionne pas ..

Les soucis rencontré une fois la Macro effectuée : (Sachant que je l'exécute depuis la feuille Mise à jour, la feuille d'extraction a pour but d'être cachée à la fin …)
.Le curseur change de page et vient se positionner en K5 sur la page d'extraction
.La copie ne nouveaux noms se fait bien en décalant tout le reste, mais en cas de suppression, il faudrait que ca supprime toute la ligne, et non juste le contenu des colonnes A:F, car là, en cas de suppression, le contenu des autres colonnes se retrouve affecté au nom précédent/suivant
.Une fois la Macro effectuée, tout le tableau reste en surbrillance 'Sélectionné' (pas très clair lol)

J'ai également tenté d'apporter les modifications suivantes :
. L'en-tête du tableau est en ligne 5, début du contenu en A6 (Pour me laisser 4 lignes pour mettre des boutons d'exécution de Macro)
. Le tri final doit être effectué en fonction du Nom (Col B), et non du Matricule pour un soucis de lisibilité.


Je continue de travailler sur ce bout de code en tout cas ! Je dois être opérationnel pour lundi, ma Dead-line se réduit durement ! lol
Merci d'avance pour l'aide :-/
 

Denaizzz

XLDnaute Nouveau
VB:
Sub compare_liste_tableaux()
Dim m%, n%, te, tc, derle%, derlc%
Set she = Sheets("Extraction")
Set shC = Sheets("Causeries")
te = she.Range("A6:F" & she.Cells(Rows.Count, 1).End(xlUp).Row)
tc = shC.Range("A6:F" & shC.Cells(Rows.Count, 1).End(xlUp).Row)
derle = she.Cells(Rows.Count, 1).End(xlUp).Row
derlc = shC.Cells(Rows.Count, 1).End(xlUp).Row
'--- suppression lignes non retrouv?es tableau "Extraction"
For m = LBound(tc, 1) To UBound(tc, 1)
  For n = LBound(te, 1) To UBound(te, 1)
  If tc(m, 1) = te(n, 1) Then
  GoTo prochain
  Else
  End If
  Next n
  shC.Rows(m + 1).Delete
prochain:
Next m
'--- ajout nouvelle ligne issue du tableau "Causeries"
derle = she.Cells(Rows.Count, 1).End(xlUp).Row
derlc = shC.Cells(Rows.Count, 1).End(xlUp).Row
For m = LBound(te, 1) To UBound(te, 1)
  For n = LBound(tc, 1) To UBound(tc, 1)
  If te(m, 1) = tc(n, 1) Then
  GoTo prochain2
  Else
  End If
  Next n
  she.Rows(m + 1).Copy shC.Rows(derlc + 1)
  derlc = shC.Cells(Rows.Count, 1).End(xlUp).Row
prochain2:
Next m
'--- tri ? nouveau de tous les tableaux
Call tri_tableau_sheetsCE
shC.Select: Range("A1").Select
End Sub
Sub z_copy_row()
'--- pour essai
Set she = Sheets("Extraction")
Set shC = Sheets("Causeries")
te = she.Range("A6:F" & she.Cells(Rows.Count, 1).End(xlUp).Row)
tc = shC.Range("A6:F" & shC.Cells(Rows.Count, 1).End(xlUp).Row)
derle = she.Cells(Rows.Count, 1).End(xlUp).Row
derlc = shC.Cells(Rows.Count, 1).End(xlUp).Row
For m = LBound(te, 1) To UBound(te, 1)
  For n = LBound(tc, 1) To UBound(tc, 1)
  If te(m, 1) = tc(n, 1) Then
  GoTo prochain2
  Else
  End If
  Next n
  she.Rows(m + 1).Copy shC.Rows(derlc + 1)
  derlc = shC.Cells(Rows.Count, 1).End(xlUp).Row
prochain2:
Next m
End Sub
Sub tri_tableau_sheetsCE()
Dim i%
For i = 1 To 2
  Sheets(i).Activate: Range("B6").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
  DataOption1:=xlSortNormal
Next i
End Sub
Voila les modifications que j'ai essayé d'apporter mais ça ne fonctionne pas :/

remplacer A2 par A6, et mettre .end(Xls) au lieu de .end(3)
Mais, le tableau est remonté d'une ligne et me recopie l'en-tête a chaque fois :/
 

Denaizzz

XLDnaute Nouveau
Bonjour.
Parce qu'elle ne me permets pas de réaliser des modification… Objectif recherché
(L'exemple sera plus parlant)

Comme on le dit toujours, Faire compliqué, c'est simple !
Faire simple, c'est compliqué ...
 

Fichiers joints

zebanx

XLDnaute Impliqué
Bonjour Denaizz, Pierre-Jean, le forum

Un autre essai avec les 5 lignes laissées sur la sheets(2).
Effectivement, pour la suppression des lignes, il fallait partir du Ubound vers Lbound, c'est mieux, bonne remarque.
Je signale que la problématique des doublons n'a pas été prise en compte non plus.
La la macro ne les écrase pas.

Il serait plus simple quand même d'attacher un fichier au départ...surtout quand on cherche depuis 1 semaine:D car évidemment vous savez ce que vous voulez, sans fichier, nous ne le saurons jamais.

@+


@Pierre-jean : choix... judicieux.;)
 

Fichiers joints

Denaizzz

XLDnaute Nouveau
Ca s'améliore, mais ça ne fonctionne toujours pas …

Je viens de tester ..
Lorsque je supprime la ligne correspondant à un employé dans le 1er tableau,
la mise à jour se fait sur le second, mais seulement des Colonnes A à F (Celles extraites)
Les autres colonnes ne bougent pas, ce qui fait que les formations réalisées par cette personne se retrouvent sur la personne suivante…
De même, j'ai du désactiver le tri automatique, il ne trie que ces même colonnes, et les colonnes suivantes restent à la même position…

J'ai un doute sur une chose :

Est-il possible que mon tableau d'origine étant considéré comme un tableau dynamique, il copie les "paramètre" de la feuille 1 vers la 2, et donc n'appliquent pas le tri et suppression sur la suite de la ligne ?
 
Dernière édition:

Denaizzz

XLDnaute Nouveau
Arf ! Je confirme …
En fait, pour le test, j'ai mis à jour ma liste des membres du personnel, et à coté, j'étais venu 'Coller' un tableau que j'avais déjà commencé.
Hors, il me faut recréer l'intégralité du tableau sinon les en-tête ne semblent pas s'ajouter au tableau Dynamique (Si c'en est un …), et les lignes correspondantes ne se suppriment pas …
[Je rapporte mon retour d'expérience, au cas où ça aiderai quelqu'un d'autre ...

Par contre, le tri ne fonctionne pas correctement. Il me tri bien les colonnes de A à F, mais les autres colonnes de la ligne que je rajoute ne suivent pas …
Une idée de quelle variable ajuster ?

Désolé de n'avoir pu mettre de document exemple dès le départ)
 
Dernière édition:

Denaizzz

XLDnaute Nouveau
J'ai trouvé une piste !!
En Pour la sélection de la zone à trier, on part du A6, vers le bas, et vers la gauche …
Sauf que si je n'ai rien de rempli dans les colonnes suivantes, celle-ci ne sont pas sélectionnées.
il faut donc se référer à la colonne en-tête pour définir le nombre de Colonnes à choisir, je vais essayer de faire un bout de code, mais si l'un d'entre vous à la solution, je veux bien, ma femme me dit que j'ai les yeux d'un lapin qui a la myxomatose lol !
VB:
[B]Sub tri_tableau_sheetsCE()
Dim i%

With Sheets("C")
  .Activate
  .Range("A6").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
  DataOption1:=xlSortNormal
  .Cells(Cells(Rows.Count, 1).End(3).Row, 1).Select
End With
End Sub[/B]
 

zebanx

XLDnaute Impliqué
Re-

Envoyez-moi votre fichier svp COMPLET ...ce sera mieux et avec des données bidons, c'est pas le sujet.
Je ne peux pas vous répondre sur un fichier dont vous même avez la main quand l'exemple transmis en 9 ne faisait que 5 colonnes...
 
Dernière édition:

Denaizzz

XLDnaute Nouveau
Oui ..

Après tout …
Depuis le départ, je fais de la rétention d'information parce que je ne voulais pas laisser filtrer des informations confidentielles, mais au final, personne ne me comprend.
J'ai donc recréé mon tableau en y mettant des informations eronnées, histoire que vous puissiez comprendre plus facilement
 

Fichiers joints

zebanx

XLDnaute Impliqué
Re

Modifié. A mettre dans ton code principal, tu dois pouvoir terminer ce travail ;)

@+

VB:
Sub Macro3()

With Sheets("Causeries")
.Activate
dercol = Range("A5").End(2).Column
derligne = Cells(Rows.Count, 1).End(3).Row
Range(Cells(5, 1), Cells(derligne, dercol)).Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
.Cells(Cells(Rows.Count, 1).End(3).Row, 1).Select
End With

With Sheets("Extraction")
.Activate
dercol = Range("A5").End(2).Column
derligne = Cells(Rows.Count, 1).End(3).Row
Range(Cells(1, 1), Cells(derligne, dercol)).Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
.Cells(Cells(Rows.Count, 1).End(3).Row, 1).Select
End With
 

Fichiers joints

Discussions similaires


Haut Bas