XL 2013 besoin d'aide pour modification code VBA

[an@s]

Bonjour à tous,
dans mon l'exemple ci-joint j'ai une macro qui me permet d'importer le nom des employés du classeur Paie-Mens vers Refac,
dans le ficher Refac en cliquant sur "copier données" le code copie les noms de tout les employés du mois en cours y compris les nouveaux, et moi ce que je fais par la suite je donne à chaque employé une imputation (colonne AD) et à la fin de chaque mois je copie tout les noms des employés que j'ai dans la colonne F dans la colonne AE pour faire la comparaison par la suite.
le problème c'est que si j'ai des nouveaux employés et en faisant l'importation des données, , la colonne F ou j'ai les noms se décale mais la colonne AD ou j'ai les imputations ne bouge pas.

donc ce que je souhaite avoir en faisant l'importation:
-si un nom existe dans la colonne F et n'existe pas dans la colonne AE donc il s'agit d'un nouveau employé donc ajouter une ligne avec la cellule de la colonne AD vide
-si un nom existe dans la colonne AE et n'existe pas dans la colonne F donc un employé ne bosse plus dans cette société donc supprimer la ligne qui correspond a cette employé

Merci d'avance

 

[Bebere]

Bonjour an,le forum
bienvenue
code dans module1,changé formule en colonne AF

 

[job75]

Bonjour an@s, Bebere,

2 remarques :

- les colonnes F de vos 2 fichiers sont identiques, ce n'est donc guère parlant pour tester...

- dans la mesure où la macro utilise correctement les données du mois en cours, les noms du mois précédent en colonne AE et la formule de vérification en colonne AF n'ont plus aucun intérêt.

La macro de mise à jour de la feuille "REFAC" (1er bouton) :

Private Sub CommandButton1_Click()
Dim t, nlig&, d As Object, i&, rest(), d1 As Object, n&, j%, a
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\Paie-Mens.xlsx").Sheets("Feuil1")
  t = .Range("F5", .Range("F" & .Rows.Count).End(xlUp)(4))
  nlig = UBound(t)
  .Parent.Close False
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
  If t(i, 1) <> "" Then d(t(i, 1)) = ""
Next i
If d.Count = 0 Then GoTo 1 'si aucun nom
t = Range("A3:AD" & Range("F" & Rows.Count).End(xlUp)(2).Row)
ReDim rest(1 To nlig, 1 To 30) 'colonnes A à AD
Set d1 = CreateObject("Scripting.Dictionary")
'---noms en commun---
For i = 1 To UBound(t)
  If t(i, 6) <> "" And d.Exists(t(i, 6)) Then
    n = n + 1
    d1(t(i, 6)) = ""
    For j = 1 To 30
      rest(n, j) = t(i, j)
    Next j
  End If
Next i
'---noms nouveaux---
a = d.Keys
For i = 0 To UBound(a)
  If Not d1.Exists(a(i)) Then
    n = n + 1
    rest(n, 6) = a(i)
  End If
Next i
'---restitution---
1 [AE:AF].Delete 'ces colonnes ne servent à rien...
Range("A3:AD" & Rows.Count).ClearContents 'RAZ
If n = 0 Then Exit Sub
[A3].Resize(n, 30) = rest
[A3].Resize(n, 30).Sort [F3], xlAscending, Header:=xlNo 'tri sur les noms
End Sub

A+

 

[an@s]

Bonjour Job,
merci beaucoup pour votre réponse mais j'aimerais bien que vous rectifiiez quelques point :

# les noms doivent garder le même classement après mise à jour c'est important (il est fait par numéro de matricule)
# toutes les colonnes doivent être importés dans REFAC et non pas juste la colonne F (car en faisant la mise à jour avec votre code il importe juste les nouveaux nom de la colonne F et il n'importe pas les autres informations comme qualification, les heures, total coût...ect)
# la mise à jour ne doit pas toucher les colonnes AD, AE, AF parce que

EDIT :

#les colonnes AE et AF je vais les supprimer à la main de mon fichier d'origine donc pas la peine de les citer dans la macro
#si on tome sur des noms qui sont identique mais le matricule est différent il faut les copier et ne pas les exclure

 

[job75]

Re,

Vous n'aviez qu'à préciser tout ça au post #1, ça m'aurait évité de perdre mon temps.

 

[an@s]

oups, je suis vraiment désolé
peut être que je me suis mal exprimé dans le 1er post

 

[job75]

Re,

Pas facile de tester avec des tableaux qui ne changent pas, j'espère que cette fois c'est la bonne :

Private Sub CommandButton1_Click()
Dim t, nlig&, d As Object, i&, rest(), j&
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\Paie-Mens.xlsx").Sheets("Feuil1")
  t = .Range("A5:AC" & .Range("F" & .Rows.Count).End(xlUp).Row + 2)
  nlig = UBound(t)
  .Parent.Close False
End With
'---restitution du 1er tableau---
Range("A3:AC" & Rows.Count).ClearContents 'RAZ
[A3].Resize(nlig, 29) = t
'---liste des noms du 1er tableau---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
  If t(i, 6) <> "" Then d(t(i, 6)) = i 'repère la ligne
Next i
'---création du 2ème tableau (rest)---
t = Range("AD3:AE" & Range("AE" & Rows.Count).End(xlUp).Row + 1)
ReDim rest(1 To nlig, 1 To 2)
For i = 1 To UBound(t)
  If t(i, 2) <> "" And d.Exists(t(i, 2)) Then
    j = d(t(i, 2)) 'ligne repérée
    rest(j, 1) = t(i, 1)
    rest(j, 2) = t(i, 2)
  End If
Next i
'---restitution du 2ème tableau (rest)---
Range("AD3:AF" & Rows.Count).ClearContents 'RAZ
[AD3].Resize(nlig, 3) = rest
[AF3].Resize(nlig) = "=RC6=RC[-1]"
End Sub

A+

 

[Bebere]

bonsoir an,Job
changement dans le code met le présent ou l'ajout sur la même ligne

Public Sub TransfertFversAE()
    Dim a(), b(), c(), i As Long, j As Long, k As Long

    a = Feuil01.Range("F3:G" & Feuil01.Range("F65536").End(xlUp).Row)
    b = Feuil01.Range("AE3:AE" & Feuil01.Range("AE65536").End(xlUp).Row)
    k = 1
    ReDim c(1 To 1, 1 To UBound(a))
    For i = 1 To UBound(a)    'présent
        For j = 1 To UBound(b)
            If b(j, 1) = a(i, 1) Then
                c(1, i) = a(i, 1): a(i, 2) = "": Exit For
            End If
        Next j
    Next i

    For i = 1 To UBound(a)    'ajoute
        If a(i, 2) <> "" Then
            c(1, i) = a(i, 1)
        End If
    Next i


    c = Application.Transpose(c)

    Feuil01.Range("AE3:AE" & Feuil01.Range("AE65536").End(xlUp).Row).ClearContents
    Feuil01.Range("AE3").Resize(UBound(c, 1), 1) = c

End Sub

 

[an@s]

Bonsoir Job, le forum
comme vous pouvez constater ci-joint,
j'ai appliqué votre code sur mon fichier ou j'ai enlevé les colonnes AE et AF qui ne servent plus à rien, mais en cliquant sur "copier données" le code efface la colonne des imputations et recopie (vrai/faux) dans la colonne AF

Je pense qu'il faut exclure AE et AF du code mais je ne sais pas comment

 

[job75]

Bonjour an@s, Bebere, le forum,

La colonne AF est inutile mais la colonne AE est indispensable pour conserver le mois précédent, sans elle on ne pourrait pas reclasser les Imputations.

Pour renseigner cette colonne avec les nouveaux noms il suffit en fait de copier à la fin la colonne F :

Private Sub CommandButton1_Click()
Dim t, nlig&, d As Object, i&, rest()
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\Paie-Mens.xlsx").Sheets("Feuil1")
  t = .Range("A5:AC" & .Range("F" & .Rows.Count).End(xlUp).Row + 2)
  nlig = UBound(t)
  .Parent.Close False
End With
'---restitution du 1er tableau---
Range("A3:AC" & Rows.Count).ClearContents 'RAZ
[A3].Resize(nlig, 29) = t
'---liste des noms du 1er tableau---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
  If t(i, 6) <> "" Then d(t(i, 6)) = i 'repère la ligne
Next i
'---création du 2ème tableau (rest)---
t = Range("AD3:AE" & Range("AE" & Rows.Count).End(xlUp).Row + 1)
ReDim rest(1 To nlig, 1 To 1)
For i = 1 To UBound(t)
  If t(i, 2) <> "" And d.Exists(t(i, 2)) Then rest(d(t(i, 2)), 1) = t(i, 1)
Next i
'---restitution du tableau rest et copie de la colonne F---
[AF:AF].Delete 'cette colonne est totalement inutile
Range("AD3:AE" & Rows.Count).ClearContents 'RAZ
[AD3].Resize(nlig) = rest
[AE3].Resize(nlig) = [F3].Resize(nlig).Value
End Sub

Edit : en fait utiliser les noms n'est pas tout à fait judicieux car il pourrait y avoir des homonymes.

Il vaudrait mieux utiliser les matricules (colonne E).

A+

 

[an@s]

Bonjour Job, bebere, le forum,

merci beaucoup pour votre réponse c'es exactement ce que je voulais
il reste juste une petite remarque c'est que dans la colonne AE je dois avoir les noms du mois précédent c'est à dire copier la colonne F dans AE avant d'importer les noms du mois en cours parce que votre macro il copie la colonne F dans AE après mise à jour des informations

EDIT: donc dans AD les imputations qui sont vide la cellule correspondante dans AE doit être aussi vide

ci-joint dans le fichier REFAC vous trouverez dans la ligne 10 le résultat que je dosi avoir tout en sachant que le nom n'existait pas dans le mois précédent

Amicalement
An@s

 

[job75]

Re,

Ah oui d'accord, on peut renseigner la colonne AE avant de modifier le tableau et la supprimer à la fin.

Comme je l'ai dit j'utilise maintenant la colonne E des matricules comme repérage :

Private Sub CommandButton1_Click()
Dim t, nlig&, d As Object, i&, rest(), j&
Application.ScreenUpdating = False
With Workbooks.Open(ThisWorkbook.Path & "\Paie-Mens.xlsx").Sheets("Feuil1")
  t = .Range("A5:AC" & .Range("F" & .Rows.Count).End(xlUp).Row + 2)
  nlig = UBound(t)
  .Parent.Close False
End With
'---restitution du 1er tableau---
[E:E].Copy [AE1] 'sauvegarde la colonne E (matricules) en colonne auxiliaire AE
Range("A3:AC" & Rows.Count).ClearContents 'RAZ
[A3].Resize(nlig, 29) = t
'---liste des noms du 1er tableau---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
  If t(i, 5) <> "" Then d(t(i, 5)) = i 'repère la ligne
Next i
'---création du 2ème tableau (rest)---
t = Range("AD3:AE" & Range("AE" & Rows.Count).End(xlUp).Row + 1)
ReDim rest(1 To nlig, 1 To 1)
For i = 1 To UBound(t)
  If t(i, 2) <> "" And d.Exists(t(i, 2)) Then rest(d(t(i, 2)), 1) = t(i, 1)
Next i
'---restitution du 2ème tableau (rest)---
[AE:AF].Delete 'à l'origine il y avait des formules en colonne AF
Range("AD3:AD" & Rows.Count).ClearContents 'RAZ
[AD3].Resize(nlig) = rest
End Sub

A+

 

[an@s]

re Job,
j'ai supprimé le dernier post après voir fait un nouveau test
c'est exactement ce que je voulais mais j'ai constaté que vous avez pu supprimé la colonne AE alors que vous m'avez dit que c'est indispensable pour reclasser les imputations et comme je suis novice en VBA je ne vais pas demander d'explication..(lol)
par contre est ce que je peux mettre ce code si je supprime les colonnes AE et AF manuellement dans mon fichier d'origine avant d'appliquer la macro ?? :

[AE:AE].Delete 'à l'origine il y avait des formules en colonne AF

au lieu de

[AE:AF].Delete 'à l'origine il y avait des formules en colonne AF

 

[job75]

Re,

par contre est ce que je peux mettre ce code si je supprime les colonnes AE et AF manuellement dans mon fichier d'origine avant d'appliquer la macro ??

Oui sans aucun problème, et supprimer uniquement la colonne AE à la fin.

Il faut bien comprendre que la colonne AE sert de colonne auxiliaire, elle n'est utilisée que par la macro.

A+

 

[an@s]

ah d'accord j'ai compris,,
donc dans mon fichier d'origine je peux supprimer manuellement les colonnes AE et AF sans aucun problème avant d'appliquer la macro,
et si j'ai bien compris la macro crée une copie de la F dans AE et la supprime par la suite sans qu'on puisse faire la remarque sur notre fichier, c'est bien ça ?

Merci beaucoup Job pour le temps que vous avez consacré pour résoudre mon problème

Amicalement
An@s