Copier / Remplacer / Ajouter entre 2 feuilles

Le 29/01/2019 à 11:41

Bonjour au forum,

Tout d'abord, excellente année à vous.

Je me permets de venir vers vous, car j'ai un problème sur un fichier excel sur lequel le forum m'a déjà aidé auparavant.

Depuis il a légèrement évolué, mais le fonctionnement reste le même.

Le principe de fonctionnement :

Je récupère un effectif de personnes que je colle dans la feuille MAJ et via un premier bouton je les catégorise en fonction de leur type de métiers. Ensuite je réalise un transfert vers la feuille GENERAL via le bouton TRANSFERT en réorganisant les données.

Dans mon tri, je vérifie si la personne était déjà présente lors de l'ancien inventaire (j'écris "OK"), elle n'est plus là (j'écris "PARTI") et enfin elle n'était pas présente (j'écris "NOUVEAUX")

Voir fichier joint.

10tomobilus-v1.xlsm (197.14 Ko)

Le problème apparaît lorsque lorsque j'ai appuyé sur le bouton TRANSFERT, j'ai les Statuts qui apparaisse dans la colonne Z (feuille GENERAL).

Mais pour les "NOUVEAUX" je n'ai ni le numéro de sa catégorie qui se copie dans la colonne AA, ni la couleur de fond des cellules qui s'applique sur les colonnes H à Y.

Je reste à disposition pour toute demande complémentaire.

Merci d'avance.

Tom

Le 29/01/2019 à 15:23

Bonjour,

J'ai inversé tes deux traitements et ça semble donner le résultat que tu demandes.

Option Explicit

Private Sub ButtonTRANSFERT_Click()
   'Transfert des catégories et tri

   If ActiveSheet.Name <> "MAJ" Then Exit Sub
   '==================================================================================
   'Transfert des colonnes
   Dim d As Object, aa, k, i&, n&

   Set d = CreateObject("Scripting.Dictionary")
   aa = Me.Range("A1").CurrentRegion.Value
   For i = 2 To UBound(aa)
      d(aa(i, 4)) = WorksheetFunction.Index(aa, i, Array(4, 5, 1, 2, 3, 11, 13))
   Next i
   With Worksheets("GENERAL")
      aa = .Range("A1").CurrentRegion.Resize(, 1).Value
      n = UBound(aa) + 1
      For i = 2 To UBound(aa)
         k = aa(i, 1)
         If d.exists(k) Then
            .Cells(i, 1).Resize(, 7).Value = d(k)
            .Cells(i, 26) = "OK": d.Remove k
         Else
            .Cells(i, 26) = "PARTI"
         End If
      Next i
      If d.Count > 0 Then
         For Each k In d.keys
            .Cells(n, 1).Resize(, 7).Value = d(k)
            .Cells(n, 26) = "NOUVEAU": n = n + 1
         Next k
      End If
      .Activate
   End With

   '==================================================================================
   Dim dl1&: dl1 = Cells(Rows.Count, 4).End(3).Row: If dl1 = 1 Then Exit Sub
   With Worksheets("GENERAL")
      Dim dl2&, lg1&, lg2&, cod$, ctg$: Application.ScreenUpdating = 0

      dl2 = .Cells(Rows.Count, 1).End(3).Row: If dl2 = 1 Then Exit Sub
      For lg1 = 2 To dl1
         cod = Cells(lg1, 4)
         For lg2 = 2 To dl2
            With .Cells(lg2, 1)
               If .Value = cod Then
                  ctg = Cells(lg1, 14): .Offset(, 26) = ctg
                  Select Case ctg
                     Case 1: .Offset(, 8).Interior.Color = RGB(192, 192, 192): .Offset(, 12).Interior.Color = RGB(192, 192, 192): .Offset(, 13).Interior.Color = RGB(192, 192, 192): .Offset(, 14).Interior.Color = RGB(192, 192, 192): .Offset(, 15).Interior.Color = RGB(192, 192, 192): .Offset(, 16).Interior.Color = RGB(192, 192, 192): .Offset(, 17).Interior.Color = RGB(192, 192, 192): .Offset(, 19).Interior.Color = RGB(192, 192, 192): .Offset(, 20).Interior.Color = RGB(192, 192, 192): .Offset(, 21).Interior.Color = RGB(192, 192, 192): .Offset(, 23).Interior.Color = RGB(192, 192, 192): .Offset(, 24).Interior.Color = RGB(192, 192, 192)
                     Case 2: .Offset(, 7).Interior.Color = RGB(192, 192, 192): .Offset(, 9).Interior.Color = RGB(192, 192, 192): .Offset(, 10).Interior.Color = RGB(192, 192, 192): .Offset(, 11).Interior.Color = RGB(192, 192, 192): .Offset(, 13).Interior.Color = RGB(192, 192, 192): .Offset(, 14).Interior.Color = RGB(192, 192, 192): .Offset(, 15).Interior.Color = RGB(192, 192, 192): .Offset(, 17).Interior.Color = RGB(192, 192, 192): .Offset(, 18).Interior.Color = RGB(192, 192, 192): .Offset(, 19).Interior.Color = RGB(192, 192, 192): .Offset(, 21).Interior.Color = RGB(192, 192, 192): .Offset(, 22).Interior.Color = RGB(192, 192, 192): .Offset(, 23).Interior.Color = RGB(192, 192, 192): .Offset(, 24).Interior.Color = RGB(192, 192, 192)
                     Case 3: .Offset(, 9).Interior.Color = RGB(192, 192, 192): .Offset(, 10).Interior.Color = RGB(192, 192, 192): .Offset(, 11).Interior.Color = RGB(192, 192, 192): .Offset(, 12).Interior.Color = RGB(192, 192, 192): .Offset(, 13).Interior.Color = RGB(192, 192, 192): .Offset(, 14).Interior.Color = RGB(192, 192, 192): .Offset(, 15).Interior.Color = RGB(192, 192, 192): .Offset(, 16).Interior.Color = RGB(192, 192, 192): .Offset(, 17).Interior.Color = RGB(192, 192, 192): .Offset(, 18).Interior.Color = RGB(192, 192, 192): .Offset(, 19).Interior.Color = RGB(192, 192, 192): .Offset(, 20).Interior.Color = RGB(192, 192, 192): .Offset(, 21).Interior.Color = RGB(192, 192, 192): .Offset(, 22).Interior.Color = RGB(192, 192, 192): .Offset(, 23).Interior.Color = RGB(192, 192, 192): .Offset(, 24).Interior.Color = RGB(192, 192, 192)
                     Case 4: .Offset(, 7).Interior.Color = RGB(192, 192, 192): .Offset(, 9).Interior.Color = RGB(192, 192, 192): .Offset(, 10).Interior.Color = RGB(192, 192, 192): .Offset(, 11).Interior.Color = RGB(192, 192, 192): .Offset(, 13).Interior.Color = RGB(192, 192, 192): .Offset(, 14).Interior.Color = RGB(192, 192, 192): .Offset(, 15).Interior.Color = RGB(192, 192, 192): .Offset(, 17).Interior.Color = RGB(192, 192, 192): .Offset(, 18).Interior.Color = RGB(192, 192, 192): .Offset(, 19).Interior.Color = RGB(192, 192, 192): .Offset(, 20).Interior.Color = RGB(192, 192, 192): .Offset(, 21).Interior.Color = RGB(192, 192, 192): .Offset(, 22).Interior.Color = RGB(192, 192, 192): .Offset(, 23).Interior.Color = RGB(192, 192, 192): .Offset(, 24).Interior.Color = RGB(192, 192, 192)
                     Case 5: .Offset(, 8).Interior.Color = RGB(192, 192, 192): .Offset(, 12).Interior.Color = RGB(192, 192, 192): .Offset(, 13).Interior.Color = RGB(192, 192, 192): .Offset(, 14).Interior.Color = RGB(192, 192, 192): .Offset(, 15).Interior.Color = RGB(192, 192, 192): .Offset(, 16).Interior.Color = RGB(192, 192, 192): .Offset(, 17).Interior.Color = RGB(192, 192, 192): .Offset(, 18).Interior.Color = RGB(192, 192, 192): .Offset(, 20).Interior.Color = RGB(192, 192, 192): .Offset(, 21).Interior.Color = RGB(192, 192, 192): .Offset(, 23).Interior.Color = RGB(192, 192, 192)
                     Case 6: .Offset(, 7).Interior.Color = RGB(192, 192, 192): .Offset(, 9).Interior.Color = RGB(192, 192, 192): .Offset(, 10).Interior.Color = RGB(192, 192, 192): .Offset(, 11).Interior.Color = RGB(192, 192, 192): .Offset(, 12).Interior.Color = RGB(192, 192, 192): .Offset(, 14).Interior.Color = RGB(192, 192, 192): .Offset(, 15).Interior.Color = RGB(192, 192, 192): .Offset(, 16).Interior.Color = RGB(192, 192, 192): .Offset(, 18).Interior.Color = RGB(192, 192, 192): .Offset(, 19).Interior.Color = RGB(192, 192, 192): .Offset(, 20).Interior.Color = RGB(192, 192, 192): .Offset(, 22).Interior.Color = RGB(192, 192, 192): .Offset(, 23).Interior.Color = RGB(192, 192, 192): .Offset(, 24).Interior.Color = RGB(192, 192, 192)
                     Case 7: .Offset(, 7).Interior.Color = RGB(192, 192, 192): .Offset(, 8).Interior.Color = RGB(192, 192, 192): .Offset(, 9).Interior.Color = RGB(192, 192, 192): .Offset(, 10).Interior.Color = RGB(192, 192, 192): .Offset(, 11).Interior.Color = RGB(192, 192, 192): .Offset(, 12).Interior.Color = RGB(192, 192, 192): .Offset(, 13).Interior.Color = RGB(192, 192, 192): .Offset(, 16).Interior.Color = RGB(192, 192, 192): .Offset(, 17).Interior.Color = RGB(192, 192, 192): .Offset(, 18).Interior.Color = RGB(192, 192, 192): .Offset(, 19).Interior.Color = RGB(192, 192, 192): .Offset(, 20).Interior.Color = RGB(192, 192, 192): .Offset(, 21).Interior.Color = RGB(192, 192, 192): .Offset(, 22).Interior.Color = RGB(192, 192, 192): .Offset(, 23).Interior.Color = RGB(192, 192, 192): .Offset(, 24).Interior.Color = RGB(192, 192, 192)
                     Case 8: .Offset(, 7).Interior.Color = RGB(192, 192, 192): .Offset(, 9).Interior.Color = RGB(192, 192, 192): .Offset(, 10).Interior.Color = RGB(192, 192, 192): .Offset(, 11).Interior.Color = RGB(192, 192, 192): .Offset(, 12).Interior.Color = RGB(192, 192, 192): .Offset(, 14).Interior.Color = RGB(192, 192, 192): .Offset(, 15).Interior.Color = RGB(192, 192, 192): .Offset(, 16).Interior.Color = RGB(192, 192, 192): .Offset(, 17).Interior.Color = RGB(192, 192, 192): .Offset(, 18).Interior.Color = RGB(192, 192, 192): .Offset(, 19).Interior.Color = RGB(192, 192, 192): .Offset(, 20).Interior.Color = RGB(192, 192, 192): .Offset(, 22).Interior.Color = RGB(192, 192, 192): .Offset(, 23).Interior.Color = RGB(192, 192, 192): .Offset(, 24).Interior.Color = RGB(192, 192, 192)
                  End Select
               End If
            End With
         Next lg2
      Next lg1
      .Select
   End With

End Sub

ric

Le 29/01/2019 à 17:54

Bonjour RIC,

C'était tellement simple que je n'y avais même pas songé

Merci beaucoup c'est exactement ce que je voulais

Bonne fin de journée

Le 29/01/2019 à 19:47

ric

Le 29/01/2019 à 19:55

Salut Tomobilus,

Salut ric,

ton code revisité à ma sauce...

Pas habitué au dictionnaire, j'ai cru comprendre que son fonctionnement impliquait de trimbaler ta BDD complète dans les deux feuilles 'MAJ' et 'GENERAL' Juste ?

Pourquoi ne pas faire tes MAJ directement dans 'GENERAL' ? Je suppose que tu as de bonnes raisons...

Ici, dans 'MAJ', tu n'as besoin que des lignes à mettre à jour.

Pour signaler un employé en partance, il te suffit d'effacer son nom en 'MAJ', l'exécution de la mise à jour se chargeant de l'éliminer alors de 'MAJ'.

Sans vouloir m'appesantir, tes multiples MFC mériteraient une... MAJ, non ?

Private Sub ButtonTRANSFERT_Click()
'
Dim rCel As Range, iRow%, iRowGEN%, x%, y%
'
On Error Resume Next
With Worksheets("GENERAL")
    If [D2] = "" Or .[A2] = "" Then Exit Sub
    .Cells.Borders.LineStyle = xlLineStyleNone
    For x = Range("D" & Rows.Count).End(xlUp).Row To 2 Step -1
        iRowGEN = .Range("A" & Rows.Count).End(xlUp).Row
        Set rCel = .Range("A2:A" & iRowGEN).Find(what:=Cells(x, 4), lookat:=xlWhole)
        iRow = iRowGEN + 1
        If Not rCel Is Nothing Then iRow = rCel.Row
        If Cells(x, 5) = "" Then
            .Cells(iRow, 26) = "PARTI"
            Rows(x).Delete shift:=xlUp
        Else
            For y = 1 To 18
                If y < 9 Then .Cells(iRow, Choose(y, 3, 4, 5, 1, 2, 6, 7, 27)) = Cells(x, Choose(y, 1, 2, 3, 4, 5, 11, 13, 14))
                .Cells(iRow, y + 7).Interior.Color = Worksheets("TRI").Cells(.Cells(iRow, 27) + 1, y + 7).Interior.Color
            Next
            .Cells(iRow, 26) = IIf(iRow <= iRowGEN, "OK", "NOUVEAU")
        End If
    Next
    .Range("H2:Y" & iRowGEN).Borders.LineStyle = xlContinuous
    .Activate
    .Range("A:AA").AutoFit
    .Range("A1:AA1").Select
    ActiveWindow.Zoom = True
    .[A1].Select
End With
On Error GoTo 0
'
End Sub

A+

4tomobilus-v1.xlsm (172.43 Ko)

Le 30/01/2019 à 08:30

Bonjour Curulis57

Merci beaucoup de ta proposition de code.

J'ai mes raisons de ne pas faire la mise à jour depuis GENERAL (on m'a déjà proposé cette idée)

En effet, il faut que je fasse un sacré tri dans mes MFC

Bonne continuation à vous

Rechercher des sujets similaires à "copier remplacer ajouter entre feuilles"