Ouvrir fichier excel dans sous repertoire et renommer ceux ci
Résolu
nicroq
-
nicroq -
nicroq -
Bonsoir a tous et merci pour votre aide,
je souhaiterai par VBA ouvrir les fichier ".xls" d'un sous repertoire de mon fichier mère et de les renommer par la cellule "A1" du fichier qui s'ouvre?
Par exemple mon chemin :
C:\dossier\monfichier\test\fichier1.xls
C:\dossier\monfichier\test\fichier2.xls
C:\dossier\monfichier\test\fichier3.xls
Mon fichier mère se trouve dans "monfichier" et je voudrais ouvrir les fichier .xls présent dans "test" (fichier1 puis fichier 2 puis fichier3) et renommer fichier1 par sa cellule "A1" puis fichier2 par sa cellule "A1" puis fichier3 par sa cellule "A1".
en vous remerciant
Cordialement
je souhaiterai par VBA ouvrir les fichier ".xls" d'un sous repertoire de mon fichier mère et de les renommer par la cellule "A1" du fichier qui s'ouvre?
Par exemple mon chemin :
C:\dossier\monfichier\test\fichier1.xls
C:\dossier\monfichier\test\fichier2.xls
C:\dossier\monfichier\test\fichier3.xls
Mon fichier mère se trouve dans "monfichier" et je voudrais ouvrir les fichier .xls présent dans "test" (fichier1 puis fichier 2 puis fichier3) et renommer fichier1 par sa cellule "A1" puis fichier2 par sa cellule "A1" puis fichier3 par sa cellule "A1".
en vous remerciant
Cordialement
A voir également:
- Ouvrir fichier excel dans sous repertoire et renommer ceux ci
- Comment ouvrir un fichier epub ? - Guide
- Ouvrir fichier .bin - Guide
- Ouvrir fichier .dat - Guide
- Comment ouvrir un fichier docx ? - Guide
- Word et excel gratuit - Guide
3 réponses
Bonjour,
Sur un fichier excel annexe (le fichier "mère" par exemple) :
Cordialement.
Sur un fichier excel annexe (le fichier "mère" par exemple) :
Sub Code()
Dim Fich1 As String, Nouvfich1 As String, Fich2 As String, Nouvfich2 As String, Fich3 As String, Nouvfich3 As String
'******************************************************************************************
Fich1 = "C:\dossier\monfichier\test\fichier1.xls"
Workbooks.Open Filename:=Fich1
Nouvfich1 = Workbooks("fichier1.xls").Sheets(1).Range("A1").Value & ".xls"
Workbooks("fichier1.xls").SaveAs Nouvfich1
Kill (Fich1) 'Ligne à ne mettre que si vous voulez qu'il ne reste que le fichier avec son nouveau nom
Workbooks(Nouvfich1).Close 'Si vous voulez fermer le fichier après l'enregistrement
'********************************************************************************************
Fich2 = "C:\dossier\monfichier\test\fichier2.xls"
Workbooks.Open Filename:=Fich2
Nouvfich2 = Workbooks("fichier2.xls").Sheets(1).Range("A1").Value & ".xls"
Workbooks("fichier2.xls").SaveAs Nouvfich1
Kill (Fich2) 'Ligne à ne mettre que si vous voulez qu'il ne reste que le fichier avec son nouveau nom
Workbooks(Nouvfich2).Close 'Si vous voulez fermer le fichier après l'enregistrement
'**********************************************************************************************
Fich3 = "C:\dossier\monfichier\test\fichier3.xls"
Workbooks.Open Filename:=Fich3
Nouvfich3 = Workbooks("fichier3.xls").Sheets(1).Range("A1").Value & ".xls"
Workbooks("fichier3.xls").SaveAs Nouvfich1
Kill (Fich3) 'Ligne à ne mettre que si vous voulez qu'il ne reste que le fichier avec son nouveau nom
Workbooks(Nouvfich3).Close 'Si vous voulez fermer le fichier après l'enregistrement
End Sub
Cordialement.
re bonjour kuartz,
je viens de tester la macro mais celle ci bug, elle me redemande de renommer le fichier qu'elle vient de me renommer, et je n arrive pas a trouver d ou vient l erreur
merci de m aider
cordialement
je viens de tester la macro mais celle ci bug, elle me redemande de renommer le fichier qu'elle vient de me renommer, et je n arrive pas a trouver d ou vient l erreur
merci de m aider
cordialement
Sub Code()
Dim Fichier As String, Chemin As String, Wb As Workbook
Chemin = "C:\dossier\monfichier\test\"
Fichier = Dir(Chemin & "*.xls")
Do While Fichier <> ""
Set Wb = Workbooks.Open(Chemin & Fichier)
On Error Resume Next
Wb.SaveAs Wb.Sheets(1).Range("A1").Value & ".xls"
Wb.Close False
Set Wb = Nothing
Fichier = Dir
Loop
End Sub
On peut faire comme ça mais qu'est ce qui bug? Quel est le message affiché?
Bonjour nicroq,
Le code modifié pour un enregistrement au bon endroit :
Cordialement.
Le code modifié pour un enregistrement au bon endroit :
Sub Code()
Dim Fichier As String, Chemin As String, Wb As Workbook
Chemin = "C:\dossier\monfichier\test\"
Fichier = Dir(Chemin & "*.xls")
Do While Fichier <> ""
Set Wb = Workbooks.Open(Chemin & Fichier)
On Error Resume Next
Wb.SaveAs Filename:=Chemin & Wb.Sheets(1).Range("A1").Value & ".xls"
Wb.Close False
Set Wb = Nothing
Fichier = Dir
Loop
End Sub
Cordialement.
Si vous voulez répéter l'opération sur tous les fichiers présents dans le dossier, je vous propose : (je n'ai pas pu le tester, merci de me revenir)
Sub Code() Dim Fichier As String, Chemin As String, Wb As Workbook Chemin = "C:\dossier\monfichier\test\" Fichier = Dir(Chemin & "*.xls") Do While Fichier <> "" Set Wb = Workbooks.Open(Chemin & Fichier) Wb.SaveAs Wb.Sheets(1).Range("A1").Value & ".xls" Kill (Chemin & Fichier) Wb.Close False Set Wb = Nothing Fichier = Dir Loop End SubCordialement.
cependant, dans mon exemple j' ai mis fichier1, fichier2, fichier3 mais en fait je ne connais pas les nom des fichiers dans le sous repertoire, ils seront variables car ils proviennent du export logiciel, c est pour cela que je souhaite ouvrir les fichiers qui ont leur extension fichier ".xls" du sous repertoire un par un et les renommer par leur cellule A1.
cela est il possible?
cordialement
bonne journée et encore merci enormement
Cordialement.
je viens de tester la macro mais celle ci bug, elle me redemande de renommer le fichier qu'elle vient de me renommer, et je n arrive pas a trouver d ou vient l erreur
et du coup cela supprime mes fichiers ou me le copie dans mes documents .. je ne comprend pas pourquoi;...
merci de m aider
cordialement