Création base de données à partir de fichiers multiples
Résolu/Fermé
Villette54
Messages postés
300
Date d'inscription
vendredi 15 mars 2013
Statut
Membre
Dernière intervention
31 juillet 2018
-
28 janv. 2016 à 11:50
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 15 mars 2023 - 29 janv. 2016 à 11:57
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 15 mars 2023 - 29 janv. 2016 à 11:57
A voir également:
- Création base de données à partir de fichiers multiples
- Annuaire portable gratuit a partir d'un nom ✓ - Forum Mobile
- Media creation tool - Télécharger - Systèmes d'exploitation
- Wetransfer gratuit fichiers lourd - Guide
- Comment trouver un numéro à partir du nom et prénom ✓ - Forum Mobile
- Exemple base de données access à télécharger gratuit - Forum Access
3 réponses
michel_m
Messages postés
16593
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
7 mars 2023
3 291
28 janv. 2016 à 13:24
28 janv. 2016 à 13:24
bonjour
voir 2 ou 3 fichiers source faciliterait le travail
pour cela
Dans l’attente
voir 2 ou 3 fichiers source faciliterait le travail
pour cela
Mettre les classeurs en 1 "zip" sans données confidentielles en pièce jointe sur https://www.cjoint.com/
et coller le raccourci proposé (clic droit) dans le message de réponse
Dans l’attente
f894009
Messages postés
16904
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 mars 2023
1 678
Modifié par f894009 le 28/01/2016 à 15:59
Modifié par f894009 le 28/01/2016 à 15:59
Bonjour,
Salut michel_m
Villette54:
une facon de faire: un fichier Modele_Total qui est enregistre Total_2016 pour cette annee et sera 2017 pour l'an prochain
dossier a decompresser, adaptez le chemin
https://www.cjoint.com/c/FACoToM7ELf
code avec commentaires (ben oui, ai un peu oublie dans le fichier)
Salut michel_m
Villette54:
une facon de faire: un fichier Modele_Total qui est enregistre Total_2016 pour cette annee et sera 2017 pour l'an prochain
dossier a decompresser, adaptez le chemin
https://www.cjoint.com/c/FACoToM7ELf
code avec commentaires (ben oui, ai un peu oublie dans le fichier)
Sub recup_infos()
Dim TInfos, derlig, Fichier, rep
rep = "D:\Déchets\Enlèvements\"
Application.ScreenUpdating = False 'fige ecran
Set WBT = Workbooks.Open("D:\Déchets\Modele_Total.xlsx") 'ouverture model
With WBT.Worksheets("feuil1")
derlig = .Cells.Find("*", , , , xlByRows, xlPrevious).Row 'derniere cellule non vide feuil1
If derlig < 6 Then derlig = 6 'pas effacer entete si vide
.Range("A6:J" & derlig).ClearContents 'efface derniere recup
End With
Fichier = Dir(rep & "Enlèvement*.xlsx") 'premier fichier
If Fichier <> Empty Then 'fichier existe
Do
Workbooks.Open rep & Fichier 'ouverture fichier
TInfos = ActiveWorkbook.Worksheets("Sheet1").Range("A6:I30").Value 'mise en memoire plage
ActiveWorkbook.Close False 'fermeture fichier sans sauvegarde
'edriture fichier model
With WBT.Worksheets("feuil1")
derlig = .Range("A" & Rows.Count).End(xlUp).Row + 1 'derniere cellule non vide +1 colonne A
If derlig < 6 Then derlig = 6 ' si vide pour premier fichier
.Range("A" & derlig & ":I" & derlig + 24) = TInfos 'restitution infos
.Range("J" & derlig) = Fichier 'nom du fichier recupere
End With
Fichier = Dir 'fichier suivant
Loop Until Fichier = Empty 'boucle jusqu'a plus de fichier
WBT.SaveAs ("D:\Déchets\Total_" & Year(Date) & ".xlsx") 'sauvegarde avec annee en cours
WBT.Close 'fermeture
Else
MsgBox "Pas de fichier dans ce repertoire: " & rep
WBT.Close
Exit Sub
End If
Application.ScreenUpdating = True
MsgBox "Recuperation Ok"
End Sub
Villette54
Messages postés
300
Date d'inscription
vendredi 15 mars 2013
Statut
Membre
Dernière intervention
31 juillet 2018
28
29 janv. 2016 à 08:23
29 janv. 2016 à 08:23
Bonjour,
Que dire à part un grand merci ?
C'est exactement ce qu'il me fallait. De plus la macro est "simple" à comprendre (les commentaires aident bien). Ce qui me permettra de la ré-utiliser en l'adaptant un peu pour d'autres usages.
Encore une fois, merci beaucoup.
Bonne journée,
Villette.
Que dire à part un grand merci ?
C'est exactement ce qu'il me fallait. De plus la macro est "simple" à comprendre (les commentaires aident bien). Ce qui me permettra de la ré-utiliser en l'adaptant un peu pour d'autres usages.
Encore une fois, merci beaucoup.
Bonne journée,
Villette.
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
29 janv. 2016 à 09:16
29 janv. 2016 à 09:16
Bonjour,
Une autre façon de faire, sans ouvrir les fichiers...
Source
Copier/Coller ce code dans un module d'un nouveau classeur :
Une autre façon de faire, sans ouvrir les fichiers...
Source
Copier/Coller ce code dans un module d'un nouveau classeur :
Option Explicit
Sub ImporterDonnees()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Application.ScreenUpdating = False
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
If objFolder Is Nothing Then
MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else
Cells.ClearContents
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
fichier = Dir(Chemin & "*.xls")
Do While Len(fichier) > 0
If fichier <> ThisWorkbook.Name Then
ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]Sheet1'!$A$6:$I$30"
With Sheets("Feuil2")
.[A6:I30] = "=Plage"
.[A6:I30].Copy
Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(2, 0).PasteSpecial xlPasteValues
Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(0, 10) = fichier
End With
End If
fichier = Dir()
Loop
ThisWorkbook.Names("Plage").Delete
[A1].Select
End If
End Sub
Villette54
Messages postés
300
Date d'inscription
vendredi 15 mars 2013
Statut
Membre
Dernière intervention
31 juillet 2018
28
29 janv. 2016 à 11:45
29 janv. 2016 à 11:45
Merci pour cette seconde solution !
Je l'essayerai dès que possible. En revanche celle-ci me parait un peu plus complexe à comprendre mais cela ne m'empêchera pas d'essayer :)
Bref, un grand merci également.
Bonne journée,
Villette.
Je l'essayerai dès que possible. En revanche celle-ci me parait un peu plus complexe à comprendre mais cela ne m'empêchera pas d'essayer :)
Bref, un grand merci également.
Bonne journée,
Villette.
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
>
Villette54
Messages postés
300
Date d'inscription
vendredi 15 mars 2013
Statut
Membre
Dernière intervention
31 juillet 2018
29 janv. 2016 à 11:57
29 janv. 2016 à 11:57
Tu as toutes les explications dans le lien source.
Modifié par Villette54 le 28/01/2016 à 15:21
Comme demandé, voici 3 fichiers source à titre d'exemple, désolé pour les noms je n'étais pas très inspiré. http://www.cjoint.com/c/FACooNXldJV
Malgré ce que montre le template, les matières ne dépassent jamais la ligne 30 et les lignes vides peuvent être reportées dans la base de données finale car elles ne me gênent pas.
Merci d'avance.