Créer une boucle pour copier depuis plusieurs fichiers
Bonjour à tous!
j'ai vu quelques posts sur le sujet, mais je ne parviens pas à tout synthétiser pour réussir à débloquer ma situation...
Voici le contexte :
J'ai deux types de classeurs :
- Classeur 'Base de données' : une base unique
- Classeurs 'Déclaration déplacement' : autant de fichiers que de déplacements (environ 2000...)
La base de données référence les différentes déclarations de déplacement.
A sa création, chaque déclaration de déplacement porte un numéro (dans la cellule J2 et dans le nom du fichier->toutes les déclarations de déplacement sont indentiques et nommer de la même manière) et sont répertoriées dans la base de données.
Le but étant, une fois les déclarations de déplacement remplies, je puisse lancer une macro depuis ma base de données pour aller chercher les informations telles que numéro de passeport, téléphone, pays... et compléter la base sur la ligne de référence correspondante!
et là je bloque totalement
Dans mon exemple (PJ), Pik_Martine_3, dois envoyer les infos contenues en B13 et G10 dans la base de données en cellule F5 et G5(ligne correspondant à la mission numéro 3). Pour Smith_Angola_5, les infos B13 et G10 doivent aller en cellule F7 et G7 (ligne correspondant à la mission numéro 5). Etc... pour chacun des fichiers que contient mon répertoire.
Je sais qu'il y a des experts parmi vous, j'espère que vous pourrez m'aider dans ma quête de VBA.
Merci à tous. Je suis preneuse de tous vos savoir !!
Bonjour,
et merci beaucoup pour ton retour!
je ne dois pas bien utiliser ton fichier, car rien ne se passe quand je lance la macro?! J'ai pourtant bien modifié le chemin vers l'emplacement des mes demandes de déplacement.
Désolée :S
Bonjour
Pas facile à savoir pourquoi cela ne fonctionne pas
J'ai tester avec les 2 fichiers que tu as mis à disposition et pas de problème
Utilises tu les mêmes fichiers ?
Testes dans les mêmes conditions que moi
Dans un même répertoire (dossier) places y les 3 fichiers (celui que j'ai modifié plus les 2 que tu as posté) modifies le chemin et lances la macro
Et vérifies ce que tu obtiens
Ahah, j'ai trouvé! j'avais oublié un "\" à la fin de l'emplacement du fichier...
Je regarde dans le détail et reviens vers toi pour te dire ce que j'arrive à faire! (ajouter d'autres champs à copier notamment)
Un très grand merci en tout cas pour ce début!!!
Pourrais tu m'éclairer sur la signification de cette partie :
Debug.Print Chemin & Ws.Range("C" & J) & "_*_" & Ws.Range("A" & J) & ".xlsx"
Fichier = Dir(Chemin & Ws.Range("C" & J) & "_*_" & Ws.Range("A" & J) & ".xlsx")
Si j'ai bien compris est la numérotation, qui est en fait la clé entre mes deux fichiers.
Mais à quoi correspond le "C"?
Bonjour
La ligne Debug.Print juste là pour le débogage, tu peux la virer
Sans indications précises de ta part j'ai considéré que le nom du fichier était composé de la cellule C... puis de "_" puis de quelque chose "*" puis de "_" puis du numéro en cellule A
Bonjour!
Ca y est
J'essaye d'ajouter les autre colonnes et items à copier et reviens vers toi pour te dire combien tu es génial
Merci encore
Bonjour!
Tout marche très bien, merci!
Quelques difficultés dans le fignolage toutefois...
J'essaye de rendre automatique la macro à l'ouverture de la bse.
Je l'ai donc copié dans 'This workbook & workbook open.
Mais la macro se lance mais ne réussit pas à aller chercher les infos. Mais les message box apparaissent bien pourtant (=certitude que la macro se lance)
Quelqu'un aurait une idée du pourquoi ca ne fonctionne pas?
merci encore
Voici la macro :
Private Sub Workbook_Open()
Dim J As Long
Dim Chemin As String, Fichier As String
Dim Ws As Worksheet
Application.ScreenUpdating = False
Chemin = "D:\DATA\Missions\"
Set Ws = Sheets("BD_2014")
MsgBox "Mise à jour de la base, veuillez patienter."
For J = 3 To Ws.Range("F" & Rows.Count).End(xlUp).Row
Debug.Print Chemin & Ws.Range("F" & J) & "_*_*_*_" & Ws.Range("A" & J) & ".xlsm"
Fichier = Dir(Chemin & Ws.Range("F" & J) & "_*_*_*_" & Ws.Range("A" & J) & ".xlsm")
If Fichier <> "" Then
With Workbooks.Open(Chemin & Fichier)
With Sheets(1)
Ws.Range("B" & J) = .Range("J7") ' Statut de la mission
Ws.Range("C" & J) = .Range("D7") ' Support admin
Ws.Range("D" & J) = .Range("M5") ' Imputation
Ws.Range("H" & J) = .Range("B5") ' Date départ
Ws.Range("I" & J) = .Range("C5") ' Date retour
Ws.Range("M" & J) = .Range("H13") ' Objet de la mission
Ws.Range("N" & J) = .Range("F33") & " " & .Range("F34") ' Hôtel
Ws.Range("P" & J) = .Range("G10") ' N° de passeport
Ws.Range("Q" & J) = .Range("B11") ' N° de téléphone
Ws.Range("R" & J) = .Range("F5") ' Entité de rattachement
Ws.Range("S" & J) = .Range("J5") ' Entité d'affectation
End With
.Close savechanges:=False
End With
End If
Next J
MsgBox "Terminé"
End Sub
Bonjour
Sans ton fichier et au moins un fichier à ouvrir je ne vais pas pouvoir t'aider
Tout porte à croire que c'est un problème de nom de fichier mais d'où je suis je ne peux pas voir
Ah pardon!
les voici.
Donc quand tu ouvres la base, elle est censée se mettre à jour automatiquement avec les modifications faire dans PIK...
Mais ca ne marche pas...
Bonjour
C'est bien ce que je pensais
le nom de ton fichier n'est pas identique au modèle que tu veux
Remplaces cette ligne
Fichier = Dir(Chemin & Ws.Range("F" & J) & "_*_*_*_" & Ws.Range("A" & J) & ".xlsm")Par
Fichier = Dir(Chemin & Ws.Range("F" & J) & "_*__*_" & Ws.Range("A" & J) & ".xlsm")Plus petit bug trouvé en testant (manque le . (point) devant With .Sheets(1)
Corrigé dans cette version
Changes le chemin
Bonjour,
Ah oui ca y est, ca marche. C'était une erreur toute bête :/
Bon dernier et ultime problème (je l'espère!), j'ai un premier fichier qui doit ouvrir pour reporter des lignes dans la fameuse base.
J'ai ajouté un mdp à la base.
Voici le morceau concerné :
Dim Wb As Workbook
Dim ws As Worksheet
Set Wb = Workbooks.Open("D:\DATA\Base de données_Missions 2014")
Set ws = Wb.Worksheets(1)
Sheets("BD_2014").Select
Range("E65000").End(xlUp).Offset(1).Select
J'ai essayé :
Set Wb = Workbooks.Open Filename:="D:\DATA\Base de données_Missions 2014", Password:="test"
Mais ca ne marche pas. Il me ressort des erreurs.
Sauriez-vous me dire pourquoi?
Merci
Merci
Bonjour
Cegis a écrit :Il me ressort des erreurs.
Ah oui et lesquelles ?
Essayes (les parenthèses et peut-être l'extension)
Set Wb = Workbooks.Open(Filename:="D:\DATA\Base de données_Missions 2014.xlsx", Password:="test")j'avais déjà essayé plein de combinaison de parenthèse, mais la tienne a marché !
Mais il ne tient pas compte du mot de passe car lorsque j'active la macro, il me redemande le mot de passe pour accéder en écriture au fichier ou cliquer sur 'lecture seule'.
Bonjour
Il faut regarder dans les options de Open
Extrait de l'aide
Syntaxe
expression.Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Delimiter, Editable, Notify, Converter, AddToMru, Local, CorruptLoad)
WriteResPassword Facultatif Variant Chaîne qui contient le mot de passe requis pour écrire dans un classeur protégé en écriture. Si cet argument est omis alors que le classeur requiert un mot de passe, l’utilisateur est invité à fournir ce mot de passe.
Merci beaucoup
Tout fonctionne très bien (aujourd'hui