Exporter information de plusieurs excels dans une Base de données

[Gen_One]

Bonjour à tous,
je cherche à savoir s’il est possible d’exporter des informations de plusieurs excel en même temps dans une base de données.
Les fichiers excel on tous la même organisation, et les infos de chaque cellules sont les même dans chaque fichier excel.

J’aimerai automatiser la création d’une base de données si c’est possible.

Merci de votre réponse

[Mimimathy]

Bonjour,

A savoir plusieurs Excel (Classeurs) ou plusieurs Excel (Feuille du même classeur)

les 2 sont possibles mais sans savoir où donner de la tête il faut des exemples

[Gen_One]

Merci pour votre réponse,
il sagit de plusieurs fichiers.
Je vais essayer d’être plus clair,
Imaginons que j’ai 20 fichier différent
A.xls
B.xls
C.xls
…
U.xls

dans chaque fichier excel en feuile une il y a dans les même cellules des donnés a récupérer pour faire une base de données.

Voici le fichier en question

Fiche Test.xlsx (97,3 Ko)

Pensez vous qu’il est possible d’en faire sur un autre excel une extraction des infos et d’avoir sur ce dernier excel un base de données de tous les autres excel.

Base de données qui reprend dans chaque colonnes le nom prénom etc des 20 fichiers excel ou plus s’il y en a de nouveaux etc

merci de votre aide

[Mimimathy]

Bonjour,

Le Classeur Recap doit se trouver dans le même répertoire que les classeurs à récupérer

La macro:

Sub Recap()

'Déclaration type de variable
Dim Repertoire As String, Fichier As String 'texte
Dim WB As Workbook 'classeur
Dim wd As Worksheet 'onglet
Dim i As Integer 'nombre entier
Dim Dossier As Object
Application.ScreenUpdating = False 'désactivation défilement écran

Sheets("Recap").Activate
Range("A2:B65000").ClearContents
i = 2
Set wd = ThisWorkbook.Worksheets("Recap")
Repertoire = ThisWorkbook.Path & "\" 'définit le répertoire de recherche
Fichier = Dir(Repertoire & "*.xlsx") 'spécifie la recherche pour le fichiers .xlsx
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Repertoire)

  Do While Fichier <> "" 'boucle sur les fichiers du répertoire
    If ThisWorkbook.Name <> Fichier Then 'sauf sur ce fichier si dans même répertoire
      Set WB = Workbooks.Open(Repertoire & Fichier) 'ouvre chaque classeur
      wd.Cells(i, 1) = WB.Worksheets("Consultation N°1").Range("C14")  'Regroupe Nom
      wd.Cells(i, 2) = WB.Worksheets("Consultation N°1").Range("J14") 'Regroupe Prénom
      i = i + 1 'ajoute une ligne sur classeur destination (RECAP)
      WB.Close False 'referme le classeur sans sauvegarder
    End If
    Fichier = Dir 'Sélectionne le prochain classeur
  Loop
Range("A1").Select
End Sub

Recap.xlsm (18,9 Ko)

[Gen_One]

WHaouuuuu ça fonctionne !!!
Merci énormément je vais ajuster la macro pour qu’elle fonctionne avec d’autre cellules !
Tu es génial !!

Tu penses que ça peut fonctionner avec des fichiers xlsb ?

[Mimimathy]

Ok
Si ton probleme est resolu n’oublie pas de cliquer sur le petit sous la solution pour la valider.
A la prochaine

[Gen_One]

Je penses que je vais encore avoir besoin de votre aide.
Je ne comprend pas la macro,
Pour modifier l’extension du fichier dans la macro j’ai trouvé.
Mais il faudrait que j’extrai encore plus d’informations.
Notamment le numéro de téléphone,
L’adresse postale, mail et toutes les autres cellules de la section administration.
Pourriez-vous m’expliquer la macro que je puisse l’ajuster par la suite pour les cellules qu’ils manquent ?
Cordialement

[Mimimathy]

Re,
Il suffit d’ajouter une ligne pour chaque données à renseigner

 Set WB = Workbooks.Open(Repertoire & Fichier) 'ouvre chaque classeur
      wd.Cells(i, 1) = WB.Worksheets("Consultation N°1").Range("C14")  'Regroupe Nom
      wd.Cells(i, 2) = WB.Worksheets("Consultation N°1").Range("J14") 'Regroupe Prénom
      wd.Cells(i, 3) = WB.Worksheets("Consultation N°1").Range("cellule Dte Nais à renseigner")
      etc


      i = i + 1 'ajoute une ligne sur classeur destination (RECAP)
      WB.Close False 'referme le classeur sans sauvegarder

[Gen_One]

Merci pour ta réponse !!
Ça fonctionne !