Implementer un tableau ou un onglet avec les nouvelles valeurs

Bonjour,

Pourriez vous m'aider svp pour mettre en execution le suivant:

• En partant d'un fichier ou un onglet de BASE implementer differents onglets d'un fichier selon plusieurs criteres:
  • rajout que des valeurs existantes dans la BASE non existantes dans une feuille a la suite des valeurs presentes
    • ex en partant de l'onglet BASE -> trouver toutes les valeurs N°DOSSIER pour PIERRE (puis pareil pour JEAN) -> croisser avec les informations deja presentes dans l'onglet RAF PIERRE colonne N°DOSSIER ->et ajouter a la suite des valeurs tous ce qui n'existe pas dans la liste de l'onglet RAF PIERRE et JEAN
    • en suite quand les nouveaux dossiers sont rajoutés est il possible de rajouter les valeurs de colonne B: F dans l'onglet RAF PIERRE en partant des informations de la ligne rajouté de l'onglet de BASE

Si vous avez la possibilité de me souligner les lignes qui correspondent a ces criteres pour que je puisse adapter le code au vrai fichier car celui ci est juste le fichier d'exemple.

Merci par avance

Bonjour,

Voici, à adapter à votre fichier

Option Explicit

Sub Completer_fiches()
    Dim DerLig_f1 As Long, DerLig_f2 As Long, i As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Dim Nom As String, Feuille As String
    Dim d1 As Object, d2 As Object
    Dim c As Range

    Application.ScreenUpdating = False
    Set f1 = Sheets("BASE")
    Set d1 = CreateObject("Scripting.Dictionary") 'dictionnaire pour mémoriser les valeurs de la feuille de la personne traitée
    Set d2 = CreateObject("Scripting.Dictionary") 'dictionnaire pour mémoriser les valeurs de la feuille "BASE"

    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To DerLig_f1
        Nom = f1.Cells(i, 2) 'on relève le nom de la personne à traiter
        Feuille = "RAF " & Nom 'on applique ce nom à la feuille de même nom et commençant par "RAF "
        On Error GoTo GestionErreur 'Si la feuille n'existe pas, alors on quitte le programme
        Set f2 = Sheets(Feuille) 'Feuille attribuée à la personne testée
        DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row 'Dernière ligne de cette feuille
        For Each c In f2.Range("A2:A" & DerLig_f2) 'on passe en revue toutes les cellules de la colonne A
            If c.Text <> "" Then d1(c.Text) = "" 'on mémorise la valeur trouvée
        Next c 'Cellule suivante

        For Each c In f1.Range("A2:A" & DerLig_f1) 'on passe en revue toutes les cellules de la colonne A de la feuille "BASE"
            If c.Offset(0, 1).Value = Nom Then ' SI la cellule traitée contient bien le nom à traiter
                If c.Text <> "" Then ' et si elle n'est pas vide
                    If Not d1.exists(c.Text) Then d2(c.Text) = "" 'si la valeur n'existe pas dans le premier dictionnaire alors, on conserve cette valeur
                    If c.Offset(1, 1).Value <> c.Offset(0, 1).Value Then GoTo Restit 'si le nom suivant est différent du nom traité alors,on se dirige vers la restitution des données
                End If
            End If
        Next c

Restit:
        If d2.Count > 0 Then 'si le 2ème dictionnaire n'est pas vide
            f2.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(d2.Count, 1) = Application.Transpose(d2.keys) 'on recopie les valeurs trouvées
            d1.RemoveAll 'on vide les 2 dictionnaires
            d2.RemoveAll
            Set f2 = Nothing 'on libère la mémoire concernant la feuille "RAF NOM"
        End If
    Next i
    'libération de la mémoire
    Set f1 = Nothing
    Set d1 = Nothing
    Set d2 = Nothing
    Exit Sub

GestionErreur:
    MsgBox "la feuille " & Feuille & " n'existe pas"
End Sub

Cdlt

Edit: j'avais oublié le rapatriement des autres valeurs des colonnes C à G:

Option Explicit

Sub Completer_fiches()
    Dim DerLig_f1 As Long, DerLig_f2 As Long, i As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Dim Nom As String, Feuille As String
    Dim d1 As Object, d2 As Object
    Dim c As Range

    Application.ScreenUpdating = False
    Set f1 = Sheets("BASE")
    Set d1 = CreateObject("Scripting.Dictionary") 'dictionnaire pour mémoriser les N° de dossiers de la feuille de la personne traitée
    Set d2 = CreateObject("Scripting.Dictionary") 'dictionnaire pour mémoriser les N° de dossiers de la feuille "BASE"

    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To DerLig_f1
        Nom = f1.Cells(i, 2) 'on relève le nom de la personne à traiter
        Feuille = "RAF " & Nom 'on applique ce nom à la feuille de même nom et commençant par "RAF "
        On Error GoTo GestionErreur 'Si la feuille n'existe pas, alors on quitte le programme
        Set f2 = Sheets(Feuille) 'Feuille attribuée à la personne testée
        DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row 'Dernière ligne de cette feuille
        For Each c In f2.Range("A2:A" & DerLig_f2) 'on passe en revue toutes les cellules de la colonne A
            If c.Text <> "" Then d1(c.Text) = "" 'on mémorise la valeur trouvée
        Next c 'Cellule suivante

        For Each c In f1.Range("A2:A" & DerLig_f1) 'on passe en revue toutes les cellules de la colonne A de la feuille "BASE"
            If c.Offset(0, 1).Value = Nom Then ' SI la cellule traitée contient bien le nom à traiter
                If c.Text <> "" Then ' et si elle n'est pas vide
                    If Not d1.exists(c.Text) Then
                        d2(c.Text) = "" 'si la valeur n'existe pas dans le premier dictionnaire alors, on conserve ce N° de dossier
                    End If
                    If c.Offset(1, 1).Value <> c.Offset(0, 1).Value Then GoTo Restit 'si le nom suivant est différent du nom traité alors,on se dirige vers la restitution des données
                End If
            End If
        Next c

Restit:
        If d2.Count > 0 Then 'si le 2ème dictionnaire n'est pas vide
            DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
            f2.Range("A" & DerLig_f2).Offset(1).Resize(d2.Count, 1) = Application.Transpose(d2.keys) 'on recopie les valeurs trouvées
            d1.RemoveAll 'on vide les 2 dictionnaires
            d2.RemoveAll
        End If

        'on applique une formule pour récupérer toutes les valeurs des colonnes C à Ganciennes ou nouvelles
        DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
        f2.Range("B2:F" & DerLig_f2).FormulaR1C1 = "=IFERROR(VLOOKUP(RC1,BASE!R1C1:R" & DerLig_f1 & "C7,COLUMN()+1,0),"""")"
        f2.Range("B2:F" & DerLig_f2).Value = f2.Range("B2:F" & DerLig_f2).Value 'on remplace les formules par les valeurs obtenues
        Set f2 = Nothing 'on libère la mémoire concernant la feuille "RAF NOM"
    Next i
    'libération de la mémoire
    Set f1 = Nothing
    Set d1 = Nothing
    Set d2 = Nothing
    Exit Sub

GestionErreur:
    MsgBox "la feuille " & Feuille & " n'existe pas"
End Sub

cool merci - ça marche

j'ai juste un petit truc qui ne marche pas:

> pourriez vous voir comment remplir les champs dans RAF en partant de fihicer de base. En effet avec la macro que vous m'avez fait, les champs se remplissent mais pas avec la bonne donné car le format n'est pas identique au fichier de base - voir les colonnes A:F

MErci par avance

Bonjour,

"pourriez vous voir comment remplir les champs dans RAF en partant de fihicer de base. En effet avec la macro que vous m'avez fait, les champs se remplissent mais pas avec la bonne donné car le format n'est pas identique au fichier de base - voir les colonnes A:F"

et comment est-il ce fichier de base?

Bonjour

le voici - faudrait que je puisse rapporter avec cette macro les informations de l'onglet base vers RAF-NOM comme cela. A votre dispo

Merci par avance