Formulaires vers BDD macro excel

Salut,
Suite à cette relance, je te présente le nouveau bébé...

Les fichiers : BDD et : CRF

Les modifications :
Sub CollectInfos() : Lors du lancement de la macro "Import", une autre procédure se lance (CollectInfos). Celle ci boucle sur toutes les lignes de la base de données et stocke en mémoire (dans la variable tableau "Enregistrements") les couples Nom Prénom. Pour éviter les doublons dus à des fautes de saisie, elle stocke ces "couples" en majuscules, sans espaces.
Function EstPresent : A chaque ouverture de formulaire, cette fonction va renvoyer "True" si le couple NOMPRENOM dudit formulaire est trouvé dans la variable Enregistrements et False dans le cas contraire.
Si EstPresent = False, alors la procédure importe les données. Dans le cas contraire elle passe au formulaire suivant.

Les codes :

Option Explicit

Dim Enregistrements()

Sub Import()
'sources : https://silkyroad.developpez.com/vba/boucles/
'Nécessite d'activer la référence "Microsoft Scripting RunTime"
    'Dans l'éditeur de macros (Alt+F11):
    'Menu Outils
    'Références
    'Cochez la ligne "Microsoft Scripting RunTime".
    'Cliquez sur le bouton OK pour valider.
    
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim Repertoire As String, BaseDeDonnees As String, NomFeuil As String
    Dim Donnees(13)
    Dim DrLig As Long
    Dim Col As Byte
    
    'Empêche le refraichissement de l'écran pour ne pas ralentir la procédure
    Application.ScreenUpdating = False
    'Constantes : Nom du classeur "bdd", son répertoire et nom de la feuille
    Repertoire = ActiveWorkbook.Path
    BaseDeDonnees = ActiveWorkbook.Name
    NomFeuil = ActiveSheet.Name
    'Va entrer dans la variable tableau "enregistrements"
    'toutes les données contenues en Col B et Col C, en les concaténant
    'de manière à obtenir un tableau des enregistrements sous la forme
    'NomPrénom
    Call CollectInfos
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        If Left(FileItem.Name, 3) = "CRF" Then
            'ouverture du classeur "formulaire"
            Workbooks.Open Repertoire & "/" & FileItem.Name
            With Sheets("Nouveau contrat") 'c'est pour cette ligne que le nom de
            'la feuille est important!!!
                'remplissage des variables avec les données à extraire
                Donnees(0) = .Range("D4")
                Donnees(1) = .Range("D6")
                Donnees(2) = .Range("D7")
                Donnees(3) = .Range("G11")
                Donnees(4) = .Range("G12")
                Donnees(5) = .Range("G13")
                Donnees(6) = .Range("G14")
                Donnees(7) = .Range("G15")
                Donnees(8) = .Range("D13")
                Donnees(9) = .Range("D14")
                Donnees(10) = .Range("D15")
                Donnees(11) = .Range("D16")
                Donnees(12) = .Range("G7")
                Donnees(13) = .Range("G9")
            End With
            'fermeture du classeur "formulaire"
            ActiveWorkbook.Close
            'Si le couple NomPrénom du formulaire n'est pas présent dans la bdd
            If EstPresent(UCase(Donnees(1) & Donnees(2))) = False Then
                'restitution des données dans la base
                With Workbooks(BaseDeDonnees).Sheets(NomFeuil)
                    DrLig = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    For Col = 0 To 13
                        .Cells(DrLig, Col + 1) = Donnees(Col)
                    Next
                End With
            End If
        End If
    Next FileItem
    'réactive le refraichissement de l'écran
    'pas sur que cela soit utile, mais dans le doute...
    Application.ScreenUpdating = True
End Sub

Sub CollectInfos()
Dim Lig As Long, DrLig As Long

With Sheets("BDD")
    DrLig = .Range("B" & Rows.Count).End(xlUp).Row
    For Lig = 0 To DrLig - 1
        ReDim Preserve Enregistrements(Lig)
        Enregistrements(Lig) = UCase(.Cells(Lig + 1, 2) & .Cells(Lig + 1, 3))
    Next
End With
End Sub

Function EstPresent(Enreg As String) As Boolean
Dim i As Long

For i = 0 To UBound(Enregistrements)
    If Enreg = Enregistrements(i) Then
    EstPresent = True
    Exit Function
    End If
Next
EstPresent = False
End Function

Utilisation :
- tous les fichiers dans le même répertoire,
- Ouvrir le fichier BDD,
- se placer sur la feuille "BDD"
- ALT + F8 !!! choisir "Import" !!! Il y a maintenant 2 procédures, ne lancer que celle appelée Import...
- Exécuter

A noter : l'utilisation d'une variable tableau Enregistrements() dont la portée est : tout le module car déclarée en tête dudit module.

Cela te convient il?

Bonjour,
Alors on va attendre les fichiers : un formulaire et la bdd.
informations importantes :
- tous les formulaires sont dans le même répertoire de ton ordi?
- les formulaires ont-ils tous la même structure? (feuille de saisie au nom identiques, mêmes cellules à remplir etc...)
Attention à nous joindre grâce à cjoint.com ou ci-joint.fr des fichiers enregistrés sous au format excel 97-2003 si tu as excel >=2007. Au format .xls quoi...

Bonjour à toi Pijaku,

Tout d'abord je te remercie pour cette réponse rapide!

J'ai donc téléchargé mes fichiers à partir de ci-joint.fr, et les voici:

Formulaire:
http://www.cijoint.fr/cjlink.php?file=cj201109/cijkSAAhJo.xls

BDD:
http://www.cijoint.fr/cjlink.php?file=cj201109/cijPEeeYaE.xls

Concrètement, je souhaiterai que chaque ligne dans le fichier base de données, la 1ère étant (A2:M2), corresponde aux données en orange du fichier formulaire.
Je ne sais pas si je suis très clair, je l'espère...

S'il s'avère indispensable que les formulaires soit tous dans le même répertoire, je ferais en sorte que ce soit le cas. Et effectivement, les formulaires seront les mêmes, puisque je suis en train d'en créer un standard.

Bonjour,

Malheureusement personne n'a encore pu m'apporter de l'aide sur mon sujet, je me permets de vous resolliciter car j'ai vraiement besoin de trouver une solution. Je suis disponible tout le temps pour apporter un maximum d'informations et de précisions en cas de besoin.
J'espère que quelqu'un pourra m'accorder un peu de temps et m'eclairer!
Merci d'avance.

Ouahh, merci beaucoup, c'est parfait! Peu importe le repertoire, apparement je n'ai pas besoin de modifier le chemin d'acccès, il trouve automatiquement le repertoire de la BDD c'est ca? Sinon, j'aurai surement plusieurs feuilles après, j'essayerai d'intégrer les données a la macro, peut etre que je reviendrai vers toi pour un mini coup de main ;) Quelque colonne en plus correspondant aux qques critères supplémentaires des autres onglets, jespère m'en sortir!

Merci beaucoup!

A bientôt.

Par contre, petit detail (assez important). Quand je lance 2 fois la macro, cela me cré des doublons.
Est ce qu'il y a un moyen, pour que ca mette à jour? C'est a dire qu'il ne rajoute que ceux qui n'y sont pas encore.

Oui bien sur c'est parfait! J'ai testé, ça fonctionne très bien. Jespère que je ne me perdrait pas dans ce code un peu plus long quand j'intègrerai les données des autres onglets mais la macro correspond parfaitement à ce que je voulais. Merci mille fois!