Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Fusion de fichiers avec nom des fichiers sources

11 réponses
Avatar
lebrasyann
Bonjour,

j'ai r=E9ussi =E0 trouver sur le forum une m=E9thode qui permette de
fusionner plusieurs fichiers (100aine) en 1 seul.

J aimerai qu'=E0 chaque fois qu'il y a copie, le nom du fichier source
soit aussi r=E9cuper=E9 dans une colonne du fichier de synth=E8se.
En gros, savoir d'o=F9 proviennent les valeurs du fichier de synth=E8se.

Merci d'avance

y

10 réponses

1 2
Avatar
lebrasyann
je comprends pas trop la methode.
desole, je ne suis pas un pro de VBA.

Bonjour,

Une idée serait de récupérer le nom du fichier comme onglet dans le classeur :

quand tu es sur le classeur source :
nom¬tiveWorkbook.Name
quand tu es sur le classeur destination :
ActiveSheet.Name= nom

Camille

"" wrote:

Bonjour,

j'ai réussi à trouver sur le forum une méthode qui permette de
fusionner plusieurs fichiers (100aine) en 1 seul.

J aimerai qu'à chaque fois qu'il y a copie, le nom du fichier source
soit aussi récuperé dans une colonne du fichier de synthèse.
En gros, savoir d'où proviennent les valeurs du fichier de synthèse.

Merci d'avance

y






Avatar
lebrasyann
Le voila:
merci d avance.

Sub syntèseClasseursBD()
[A2].CurrentRegion.Offset(1, 0).Resize().Clear
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir("BD*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:="BD" & nf
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A1].CurrentRegion.Offset(1, 0).Copy
ActiveCell
Workbooks(nf).Close False
[A1].End(xlDown).Offset(1, 0).Select
nf = Dir ' fichier suivAnt
Loop
End Sub
Avatar
lebrasyann
Eh bien, je viens d'essayer.
Ca marche!
Merci beaucoup!
Maintenant, il faut que je me debrouille pour que ca copie le nom du
fichier en colonne A et les donnees du classeur à partir de la colonne
B.
Merci encore pour ton aide en tout cas!

Bonjour,

Ceci rajoutera en colonne A une ligne avec le nom du fichier copié :

Sub syntèseClasseursBD()
[A2].CurrentRegion.Offset(1, 0).Resize().Clear
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir("BD*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:="BD" & nf
Windows(fenetre).Activate
Activecell=nf
Activecell.Offset(1).Select
Workbooks(nf).ActiveSheet.[A1].CurrentRegion.Offset(1, 0).Copy
ActiveCell
Workbooks(nf).Close False
[A1].End(xlDown).Offset(1, 0).Select
nf = Dir ' fichier suivAnt
Loop
End Sub

Camille

"" wrote:

Le voila:
merci d avance.

Sub syntèseClasseursBD()
[A2].CurrentRegion.Offset(1, 0).Resize().Clear
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir("BD*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:="BD" & nf
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A1].CurrentRegion.Offset(1, 0).Copy
ActiveCell
Workbooks(nf).Close False
[A1].End(xlDown).Offset(1, 0).Select
nf = Dir ' fichier suivAnt
Loop
End Sub






Avatar
JB
Bonjour,

Consolide les BD d'un sous-Répertoire :

Sub syntèseClasseursBD()
sousRépertoire = [J2]
[A2].CurrentRegion.Offset(1, 0).Resize().Clear
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir(sousRépertoire & "*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:=sousRépertoire & "" & nf
n = [A1].CurrentRegion.Rows.Count - 1
couleur = [A2].Interior.ColorIndex
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A1].CurrentRegion.Offset(1,
0).Resize().Copy ActiveCell
Workbooks(nf).Close False
ActiveCell.End(xlToRight).Offset(0, 1).Resize(n, 1) = Left(nf,
Len(nf) - 4)
ActiveCell.End(xlToRight).Resize(n, 1).Interior.ColorIndex =
couleur
[A1].End(xlDown).Offset(1, 0).Select
nf = Dir ' fichier suivant
Loop
End Sub

http://cjoint.com/?bqnwwQ0a7t
http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/thread/d 456051d39cfdf25/b4be7e53f60906c7?lnk=gst&q=Sub+synt%C3%A8seClasseursBD( )&rnum=2&hl=fr#b4be7e53f60906c7


Cordialement JB

Bonjour,

j'ai réussi à trouver sur le forum une méthode qui permette de
fusionner plusieurs fichiers (100aine) en 1 seul.

J aimerai qu'à chaque fois qu'il y a copie, le nom du fichier source
soit aussi récuperé dans une colonne du fichier de synthèse.
En gros, savoir d'où proviennent les valeurs du fichier de synthèse.

Merci d'avance

y


Avatar
lebrasyann
Bonjour,
déjà merci pour ton aide.
j ai 2 questions:
-l interet de la consolidation est que le choix du chemin est plus
dynamique, c est ca?
-ca bloque à ces lignes:
'ActiveCell.End(xlToRight).Offset(0, 1).Resize(n, 1) = Left(nf, Len(nf)
- 4)
'ActiveCell.End(xlToRight).Resize(n, 1).Interior.ColorIndex = couleur
quel est leur interet?
merci d avance
Y

Bonjour,

Consolide les BD d'un sous-Répertoire :

Sub syntèseClasseursBD()
sousRépertoire = [J2]
[A2].CurrentRegion.Offset(1, 0).Resize().Clear
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir(sousRépertoire & "*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:=sousRépertoire & "" & nf
n = [A1].CurrentRegion.Rows.Count - 1
couleur = [A2].Interior.ColorIndex
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A1].CurrentRegion.Offset(1,
0).Resize().Copy ActiveCell
Workbooks(nf).Close False
ActiveCell.End(xlToRight).Offset(0, 1).Resize(n, 1) = Left(nf,
Len(nf) - 4)
ActiveCell.End(xlToRight).Resize(n, 1).Interior.ColorIndex =
couleur
[A1].End(xlDown).Offset(1, 0).Select
nf = Dir ' fichier suivant
Loop
End Sub

http://cjoint.com/?bqnwwQ0a7t
http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/thread /d456051d39cfdf25/b4be7e53f60906c7?lnk=gst&q=Sub+synt%C3%A8seClasseursB D()&rnum=2&hl=fr#b4be7e53f60906c7


Cordialement JB

Bonjour,

j'ai réussi à trouver sur le forum une méthode qui permette de
fusionner plusieurs fichiers (100aine) en 1 seul.

J aimerai qu'à chaque fois qu'il y a copie, le nom du fichier source
soit aussi récuperé dans une colonne du fichier de synthèse.
En gros, savoir d'où proviennent les valeurs du fichier de synthèse.

Merci d'avance

y




Avatar
JB
-Le nom du sous-répertoire (qui doit exister ) des fichiers à
consolider est paramétré en J2 (+souple)
-Sur mon poste,je n'ai pas de pb:
Il faudrait ajouter un MsgBox nf avant la boucle Do (on doit avoir
le nom du premier fichier du sous-répertoire)
-ActiveCell.End(xlToRight).Resize(n, 1).Interior.ColorIndex = couleur
n'est pas indispensable.

JB
Bonjour,
déjà merci pour ton aide.
j ai 2 questions:
-l interet de la consolidation est que le choix du chemin est plus
dynamique, c est ca?
-ca bloque à ces lignes:
'ActiveCell.End(xlToRight).Offset(0, 1).Resize(n, 1) = Left(nf, Len(nf)
- 4)
'ActiveCell.End(xlToRight).Resize(n, 1).Interior.ColorIndex = couleur
quel est leur interet?
merci d avance
Y

Bonjour,

Consolide les BD d'un sous-Répertoire :

Sub syntèseClasseursBD()
sousRépertoire = [J2]
[A2].CurrentRegion.Offset(1, 0).Resize().Clear
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir(sousRépertoire & "*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:=sousRépertoire & "" & nf
n = [A1].CurrentRegion.Rows.Count - 1
couleur = [A2].Interior.ColorIndex
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A1].CurrentRegion.Offset(1,
0).Resize().Copy ActiveCell
Workbooks(nf).Close False
ActiveCell.End(xlToRight).Offset(0, 1).Resize(n, 1) = Left(nf,
Len(nf) - 4)
ActiveCell.End(xlToRight).Resize(n, 1).Interior.ColorIndex =
couleur
[A1].End(xlDown).Offset(1, 0).Select
nf = Dir ' fichier suivant
Loop
End Sub

http://cjoint.com/?bqnwwQ0a7t
http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/thre ad/d456051d39cfdf25/b4be7e53f60906c7?lnk=gst&q=Sub+synt%C3%A8seClasseur sBD()&rnum=2&hl=fr#b4be7e53f60906c7


Cordialement JB

Bonjour,

j'ai réussi à trouver sur le forum une méthode qui permette de
fusionner plusieurs fichiers (100aine) en 1 seul.

J aimerai qu'à chaque fois qu'il y a copie, le nom du fichier source
soit aussi récuperé dans une colonne du fichier de synthèse.
En gros, savoir d'où proviennent les valeurs du fichier de synthè se.

Merci d'avance

y






Avatar
lebrasyann
Desole pour le temps de reponse Elliac.
j'ai repris ton idee et je l ai modifiee de la facon suivante:

Sub synthèseClasseursBD()
[A1].CurrentRegion.Offset(1, 0).Resize().Clear
[A1].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir("U:Etude ClientKundenübersichtBDTEST*.xls") '
premier fichier
Do While nf <> ""
Workbooks.Open Filename:="U:Etude ClientKundenübersichtBDTEST"
& nf
Windows(fenetre).Activate
ActiveCell = nf
ActiveCell.Offset(0, 1).Select
Workbooks(nf).ActiveSheet.[A1].CurrentRegion.Offset(1, 0).Copy
ActiveCell
Workbooks(nf).Close False
[B1].End(xlDown).Offset(1, -1).Select
nf = Dir ' fichier suivAnt
Loop
End Sub

et ca marche!
maintenant l etape suivante est le decoupage du nom de fichier qui s
ecrit de la facon suivante test-ok en 2 colonnes colonne A: test et
colonne B: ok

encore merci pour ton aide!
Avatar
lebrasyann
Merci mais que veut dire cette ligne?
'ActiveCell.End(xlToRight).Offset(0, 1).Resize(n, 1) = Left(nf, Len(nf)
- 4)

-Le nom du sous-répertoire (qui doit exister ) des fichiers à
consolider est paramétré en J2 (+souple)
-Sur mon poste,je n'ai pas de pb:
Il faudrait ajouter un MsgBox nf avant la boucle Do (on doit avoir
le nom du premier fichier du sous-répertoire)
-ActiveCell.End(xlToRight).Resize(n, 1).Interior.ColorIndex = couleur
n'est pas indispensable.

JB
Bonjour,
déjà merci pour ton aide.
j ai 2 questions:
-l interet de la consolidation est que le choix du chemin est plus
dynamique, c est ca?
-ca bloque à ces lignes:
'ActiveCell.End(xlToRight).Offset(0, 1).Resize(n, 1) = Left(nf, Len(n f)
- 4)
'ActiveCell.End(xlToRight).Resize(n, 1).Interior.ColorIndex = couleur
quel est leur interet?
merci d avance
Y

Bonjour,

Consolide les BD d'un sous-Répertoire :

Sub syntèseClasseursBD()
sousRépertoire = [J2]
[A2].CurrentRegion.Offset(1, 0).Resize().Clear
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir(sousRépertoire & "*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:=sousRépertoire & "" & nf
n = [A1].CurrentRegion.Rows.Count - 1
couleur = [A2].Interior.ColorIndex
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A1].CurrentRegion.Offset(1,
0).Resize().Copy ActiveCell
Workbooks(nf).Close False
ActiveCell.End(xlToRight).Offset(0, 1).Resize(n, 1) = Left(nf,
Len(nf) - 4)
ActiveCell.End(xlToRight).Resize(n, 1).Interior.ColorIndex =
couleur
[A1].End(xlDown).Offset(1, 0).Select
nf = Dir ' fichier suivant
Loop
End Sub

http://cjoint.com/?bqnwwQ0a7t
http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/th read/d456051d39cfdf25/b4be7e53f60906c7?lnk=gst&q=Sub+synt%C3%A8seClasse ursBD()&rnum=2&hl=fr#b4be7e53f60906c7


Cordialement JB

Bonjour,

j'ai réussi à trouver sur le forum une méthode qui permette de
fusionner plusieurs fichiers (100aine) en 1 seul.

J aimerai qu'à chaque fois qu'il y a copie, le nom du fichier sou rce
soit aussi récuperé dans une colonne du fichier de synthèse.
En gros, savoir d'où proviennent les valeurs du fichier de synth èse.

Merci d'avance

y








Avatar
lebrasyann
non, c est bon. j obtiens ce que je veux. je veux coller le nom du
fichier en face des donnees et ca marche.
en tout cas, merci pour ton aide.
ca m enleve une epine du pied.
merci encore

Re,

Il va y avoir un problème puisque tu veux coller les données en colon ne B.
Ce que je te propose c'est de coller les données en ligne suivante :

Sub synthèseClasseursBD()
[A1].CurrentRegion.Offset(1, 0).Resize().Clear
[A1].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir("U:Etude ClientKundenübersichtBDTEST*.xls") '
premier fichier
Do While nf <> ""
Workbooks.Open Filename:="U:Etude ClientKundenübersichtBDTEST"
& nf
Windows(fenetre).Activate
ActiveCell = nf
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDel imited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:úlse,
Tab:=True, _
Semicolon:úlse, Comma:úlse, Space:úlse, Other:=True , OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1) ), _
TrailingMinusNumbers:=True
ActiveCell.Offset(1, 1).Select
Workbooks(nf).ActiveSheet.[A1].CurrentRegion.Offset(1, 0).Copy
ActiveCell
Workbooks(nf).Close False
[B1].End(xlDown).Offset(1, -1).Select
nf = Dir ' fichier suivAnt
Loop
End Sub

Camille

"" wrote:

Desole pour le temps de reponse Elliac.
j'ai repris ton idee et je l ai modifiee de la facon suivante:

Sub synthèseClasseursBD()
[A1].CurrentRegion.Offset(1, 0).Resize().Clear
[A1].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir("U:Etude ClientKundenübersichtBDTEST*.xls") '
premier fichier
Do While nf <> ""
Workbooks.Open Filename:="U:Etude ClientKundenübersichtBDTES T"
& nf
Windows(fenetre).Activate
ActiveCell = nf
ActiveCell.Offset(0, 1).Select
Workbooks(nf).ActiveSheet.[A1].CurrentRegion.Offset(1, 0).Copy
ActiveCell
Workbooks(nf).Close False
[B1].End(xlDown).Offset(1, -1).Select
nf = Dir ' fichier suivAnt
Loop
End Sub

et ca marche!
maintenant l etape suivante est le decoupage du nom de fichier qui s
ecrit de la facon suivante test-ok en 2 colonnes colonne A: test et
colonne B: ok

encore merci pour ton aide!






Avatar
JB
C'est la ligne qui écrit le nom de fichier dans la colonne à droite
de la BD(sans l'extension.xls) (cf exemple)

JB
Merci mais que veut dire cette ligne?
'ActiveCell.End(xlToRight).Offset(0, 1).Resize(n, 1) = Left(nf, Len(nf)
- 4)

-Le nom du sous-répertoire (qui doit exister ) des fichiers à
consolider est paramétré en J2 (+souple)
-Sur mon poste,je n'ai pas de pb:
Il faudrait ajouter un MsgBox nf avant la boucle Do (on doit avoir
le nom du premier fichier du sous-répertoire)
-ActiveCell.End(xlToRight).Resize(n, 1).Interior.ColorIndex = couleur
n'est pas indispensable.

JB
Bonjour,
déjà merci pour ton aide.
j ai 2 questions:
-l interet de la consolidation est que le choix du chemin est plus
dynamique, c est ca?
-ca bloque à ces lignes:
'ActiveCell.End(xlToRight).Offset(0, 1).Resize(n, 1) = Left(nf, Len (nf)
- 4)
'ActiveCell.End(xlToRight).Resize(n, 1).Interior.ColorIndex = coule ur
quel est leur interet?
merci d avance
Y

Bonjour,

Consolide les BD d'un sous-Répertoire :

Sub syntèseClasseursBD()
sousRépertoire = [J2]
[A2].CurrentRegion.Offset(1, 0).Resize().Clear
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir(sousRépertoire & "*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:=sousRépertoire & "" & nf
n = [A1].CurrentRegion.Rows.Count - 1
couleur = [A2].Interior.ColorIndex
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A1].CurrentRegion.Offset(1,
0).Resize().Copy ActiveCell
Workbooks(nf).Close False
ActiveCell.End(xlToRight).Offset(0, 1).Resize(n, 1) = Left(nf,
Len(nf) - 4)
ActiveCell.End(xlToRight).Resize(n, 1).Interior.ColorIndex =
couleur
[A1].End(xlDown).Offset(1, 0).Select
nf = Dir ' fichier suivant
Loop
End Sub

http://cjoint.com/?bqnwwQ0a7t
http://groups.google.fr/group/microsoft.public.fr.excel/browse_frm/ thread/d456051d39cfdf25/b4be7e53f60906c7?lnk=gst&q=Sub+synt%C3%A8seClas seursBD()&rnum=2&hl=fr#b4be7e53f60906c7


Cordialement JB

Bonjour,

j'ai réussi à trouver sur le forum une méthode qui permette de
fusionner plusieurs fichiers (100aine) en 1 seul.

J aimerai qu'à chaque fois qu'il y a copie, le nom du fichier s ource
soit aussi récuperé dans une colonne du fichier de synthèse.
En gros, savoir d'où proviennent les valeurs du fichier de synt hèse.

Merci d'avance

y










1 2