renommer fichier par macro

Bonjour,

J'ai retravaillé votre procédure :-)
Est-ce que cela répond à vos attentes ?
Voici donc :

Sub prefic082()

Dim f
Dim mymsg
Dim oFS, oLecteur, oFichier, oFolder

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder("C:Q.S.E3arborescence
affairef-Q.S.E")

Application.ScreenUpdating = False
ChDir "c:Q.S.E3arborescence affairef-Q.S.E"

For Each oFichier In oFolder.Files
f = oFichier.ShortName
If (Mid(f, 1, 3) <> Range("B8").Value) Then
Application.DisplayAlerts = False
Workbooks.Open oFichier
ActiveWorkbook.SaveAs "082_06_" & f
ActiveWorkbook.Close
Kill f
Application.DisplayAlerts = True
End If
Next

' f = Dir("*.xls")

' Do While Len(f) > 0
' If Mid(f, 1, 3) <> "082" Then
' Workbooks.Open f
' Application.DisplayAlerts = False
' ActiveWorkbook.SaveAs "082_06_" & f
' Application.DisplayAlerts = True
' ActiveWorkbook.Close
' End If
' mymsg = mymsg & Chr(13) & f
' f = Dir
' Loop

Application.ScreenUpdating = True
' MsgBox "Liste des fichiers: " & mymsg

End Sub

Michel B.

-----Message d'origine-----
Bonjour à tous...
et en particulier à LE STEPH qui a eu la gentillesse de
m'envoyer , FIN 07 ,le code ci dessous et que je devais
tenir au courant après le test (tardif !!!)

Le but recherché est de renommer les fichiers d'un s/rep
par un prefixe qui se place devant le nom d'origine des
fichiers
ça marche mais:
- ça ne me prend pas tous les fichiers
- et surtout ça ne traite pas le rep que je désigne, mais
le repertoire d'enregistrement par défaut défini sur le PC
Par ailleurs, au lieu du prefixe prédéfini, j'aimerais y
mettre la ref à la cellule B8 de la feuille ou est la
macro

par ex:
prefixe=[B8]

Sub prefic082()
Dim f
Dim mymsg
ChDir "c:Q.S.E3arborescence affairef-Q.S.E"
f = Dir("*.xls")
Application.ScreenUpdating = False
Do While Len(f) > 0
If Mid(f, 1, 3) <> "082" Then
Workbooks.Open f
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "082_06_" & f
Application.DisplayAlerts = True
ActiveWorkbook.Close
End If
mymsg = mymsg & Chr(13) & f
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Liste des fichiers: " & mymsg
End Sub

Merci à STEPH ou tout cerveau puissant pouvant m'éclairer
à+
gilles
.

'Bonsoir Gilles,

Voilà qui est bien surprenant
'******

ça marche mais:
'Je l'ai effectivement testée

'avec 97 et 2003 et ne rencontre pas ces pb:

- ça ne me prend pas tous les fichiers
'Dès lors que

f = Dir("*.xls")
'cela prend tous les fichiers d'extension xls
Do While Len(f) > 0
'tant que la longueur du fichier est supérieure à 0
'(cela évite de planter s'il n'y a plus de fichiers)

- et surtout ça ne traite pas le rep que je désigne
'pour ma part je traitais un nom de rep un peu plus simple mais

'cela ne saurait pas affecter le fait de changer de rep ce que
ChDir "c:monrep"
'est sensé faire, il me semble , ou mieux vaut que j'arrête VBA
'****
'Sinon tu avais demandé comme préfixe 082...
If Mid(f, 1, 3) <> "082" Then
' Là eN Effet on ne va traiter que ceux auxquels on a pas
déjà attribué ce préfixe
'*********

Bref chez moi cela marche Nickel et je donc désolé de ne pouvoir t'aider
davantage.

Pour ton autre question remplacer "082" par [b8] devrait y pourvoir .

Je te laisse tester ce que propose Michel B, je regarderai tout cela
probablement demain
car là j'ai beau faire je n'arrive pas à reproduire ces bugs que tu obtiens.

LeSteph

"gilles" <anonymous@discussions.microsoft.com> a écrit dans le message de
news:be9401c489cb$3e6f8980$a501280a@phx.gbl...
Bonjour à tous...
et en particulier à LE STEPH qui a eu la gentillesse de
m'envoyer , FIN 07 ,le code ci dessous et que je devais
tenir au courant après le test (tardif !!!)

Le but recherché est de renommer les fichiers d'un s/rep
par un prefixe qui se place devant le nom d'origine des
fichiers
ça marche mais:
- ça ne me prend pas tous les fichiers
- et surtout ça ne traite pas le rep que je désigne, mais
le repertoire d'enregistrement par défaut défini sur le PC
Par ailleurs, au lieu du prefixe prédéfini, j'aimerais y
mettre la ref à la cellule B8 de la feuille ou est la macro
par ex:
prefixe=[B8]

Sub prefic082()
Dim f
Dim mymsg
ChDir "c:Q.S.E3arborescence affairef-Q.S.E"
f = Dir("*.xls")
Application.ScreenUpdating = False
Do While Len(f) > 0
If Mid(f, 1, 3) <> "082" Then
Workbooks.Open f
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "082_06_" & f
Application.DisplayAlerts = True
ActiveWorkbook.Close
End If
mymsg = mymsg & Chr(13) & f
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Liste des fichiers: " & mymsg
End Sub

Merci à STEPH ou tout cerveau puissant pouvant m'éclairer
à+
gilles

Bonsoir,

J'ai eu un flash, je crois qu'il peut y avoir de la
récursivité. Je m'explique, Pour chaque fichier renommé
un autre est détruit, s'il y maj de la table des
matières, il y aura récursivité pour quelques tours.

Je propose de remodeler un peu comme sas le fait, un
premier passage pour obtenir la table des matières, et un
second pour la manipulation.

J'y travaille, j'en ai maintenant besoin puisque une
collègue effectue des opérations similaires, il serait
bien de lui fournir quelque chose de stable.

Michel B.

-----Message d'origine-----
Bonjour,

J'ai retravaillé votre procédure :-)
Est-ce que cela répond à vos attentes ?
Voici donc :

Sub prefic082()

Dim f
Dim mymsg
Dim oFS, oLecteur, oFichier, oFolder

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder("C:Q.S.E3arborescence
affairef-Q.S.E")

Application.ScreenUpdating = False
ChDir "c:Q.S.E3arborescence affairef-Q.S.E"

For Each oFichier In oFolder.Files
f = oFichier.ShortName
If (Mid(f, 1, 3) <> Range("B8").Value) Then
Application.DisplayAlerts = False
Workbooks.Open oFichier
ActiveWorkbook.SaveAs "082_06_" & f
ActiveWorkbook.Close
Kill f
Application.DisplayAlerts = True
End If
Next

' f = Dir("*.xls")

' Do While Len(f) > 0
' If Mid(f, 1, 3) <> "082" Then
' Workbooks.Open f
' Application.DisplayAlerts = False
' ActiveWorkbook.SaveAs "082_06_" & f
' Application.DisplayAlerts = True
' ActiveWorkbook.Close
' End If
' mymsg = mymsg & Chr(13) & f
' f = Dir
' Loop

Application.ScreenUpdating = True
' MsgBox "Liste des fichiers: " & mymsg

End Sub

Michel B.

-----Message d'origine-----
Bonjour à tous...
et en particulier à LE STEPH qui a eu la gentillesse de
m'envoyer , FIN 07 ,le code ci dessous et que je
devais

tenir au courant après le test (tardif !!!)

Le but recherché est de renommer les fichiers d'un
s/rep

par un prefixe qui se place devant le nom d'origine des
fichiers
ça marche mais:
- ça ne me prend pas tous les fichiers
- et surtout ça ne traite pas le rep que je désigne,
mais

le repertoire d'enregistrement par défaut défini sur le
PC

Par ailleurs, au lieu du prefixe prédéfini, j'aimerais
y

mettre la ref à la cellule B8 de la feuille ou est la
macro

par ex:
prefixe=[B8]

Sub prefic082()
Dim f
Dim mymsg
ChDir "c:Q.S.E3arborescence affairef-Q.S.E"
f = Dir("*.xls")
Application.ScreenUpdating = False
Do While Len(f) > 0
If Mid(f, 1, 3) <> "082" Then
Workbooks.Open f
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "082_06_" & f
Application.DisplayAlerts = True
ActiveWorkbook.Close
End If
mymsg = mymsg & Chr(13) & f
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Liste des fichiers: " & mymsg
End Sub

Merci à STEPH ou tout cerveau puissant pouvant
m'éclairer

à+
gilles
.

.

Bonsoir,

Bon j'ai retravaillé tout ça, bien sur c'est à ma façon !
Un mieux vaux mieux que 2 tu l'auras !

Sub prefic082()

Const cteMaxf = 30000
Const cteMinf = 1

Const cteDossier = "C:Q.S.E3arborescence affairef-
Q.S.E"

Dim i, j As Integer
Dim dum As String

Dim f() As String
Dim mymsg
Dim oFS, oLecteur, oFichier, oFolder
Dim varListeNbr As Long

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder(cteDossier)

Application.ScreenUpdating = False
ChDir cteDossier

varListeNbr = oFolder.Files.Count
i = 1
If ((varListeNbr > cteMinf) And (varListeNbr <
cteMaxf)) Then
ReDim f(varListeNbr)
For Each oFichier In oFolder.Files
f(i) = oFichier.shortname
i = (i + 1)
Next oFichier

For i = 1 To varListeNbr
If (Mid(f(i), 1, 3) <> Range("B8").Value) Then
Application.DisplayAlerts = False
'Application.Dialogs(xlDialogOpen).Show

'Application.Dialogs(xlDialogSort).Show

Workbooks.Open cteDossier & f(i)
ActiveWorkbook.SaveAs cteDossier
& "082_06_" & f(i)
ActiveWorkbook.Close
Kill cteDossier & f(i)
Application.DisplayAlerts = True
End If
Next

End If

End Sub
'prudence sur alinéa

Michel

-----Message d'origine-----
Bonsoir,

J'ai eu un flash, je crois qu'il peut y avoir de la
récursivité. Je m'explique, Pour chaque fichier renommé
un autre est détruit, s'il y maj de la table des
matières, il y aura récursivité pour quelques tours.

Je propose de remodeler un peu comme sas le fait, un
premier passage pour obtenir la table des matières, et
un

second pour la manipulation.

J'y travaille, j'en ai maintenant besoin puisque une
collègue effectue des opérations similaires, il serait
bien de lui fournir quelque chose de stable.

Michel B.

-----Message d'origine-----
Bonjour,

J'ai retravaillé votre procédure :-)
Est-ce que cela répond à vos attentes ?
Voici donc :

Sub prefic082()

Dim f
Dim mymsg
Dim oFS, oLecteur, oFichier, oFolder

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder("C:Q.S.E3arborescence
affairef-Q.S.E")

Application.ScreenUpdating = False
ChDir "c:Q.S.E3arborescence affairef-Q.S.E"

For Each oFichier In oFolder.Files
f = oFichier.ShortName
If (Mid(f, 1, 3) <> Range("B8").Value) Then
Application.DisplayAlerts = False
Workbooks.Open oFichier
ActiveWorkbook.SaveAs "082_06_" & f
ActiveWorkbook.Close
Kill f
Application.DisplayAlerts = True
End If
Next

' f = Dir("*.xls")

' Do While Len(f) > 0
' If Mid(f, 1, 3) <> "082" Then
' Workbooks.Open f
' Application.DisplayAlerts = False
' ActiveWorkbook.SaveAs "082_06_" & f
' Application.DisplayAlerts = True
' ActiveWorkbook.Close
' End If
' mymsg = mymsg & Chr(13) & f
' f = Dir
' Loop

Application.ScreenUpdating = True
' MsgBox "Liste des fichiers: " & mymsg

End Sub

Michel B.

-----Message d'origine-----
Bonjour à tous...
et en particulier à LE STEPH qui a eu la gentillesse
de

m'envoyer , FIN 07 ,le code ci dessous et que je
devais

tenir au courant après le test (tardif !!!)

Le but recherché est de renommer les fichiers d'un
s/rep

par un prefixe qui se place devant le nom d'origine
des

fichiers
ça marche mais:
- ça ne me prend pas tous les fichiers
- et surtout ça ne traite pas le rep que je désigne,
mais

le repertoire d'enregistrement par défaut défini sur
le

PC

Par ailleurs, au lieu du prefixe prédéfini, j'aimerais
y

mettre la ref à la cellule B8 de la feuille ou est la
macro

par ex:
prefixe=[B8]

Sub prefic082()
Dim f
Dim mymsg
ChDir "c:Q.S.E3arborescence affairef-Q.S.E"
f = Dir("*.xls")
Application.ScreenUpdating = False
Do While Len(f) > 0
If Mid(f, 1, 3) <> "082" Then
Workbooks.Open f
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "082_06_" & f
Application.DisplayAlerts = True
ActiveWorkbook.Close
End If
mymsg = mymsg & Chr(13) & f
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Liste des fichiers: " & mymsg
End Sub

Merci à STEPH ou tout cerveau puissant pouvant
m'éclairer

à+
gilles
.

.

.

merci à STEPH et à MICHEL
J'en ai trop pour ma petite tête!
je regarde ça dès que j'ai un peu de dispo.
Pour STEPH , effectivement, je comprends que tu trouves ça
surprenant
Le REP qui est pris est celui défini par défaut
(coincidence?)
j'ai essayé en ne mettant qu'un repertoire (sans s/rep) ça
fait pareil
le rep pris en compte comporte environ 80 fichiers, dont
20 word et il traite exactement 50 fichiers xl
Pour MICHEL , je n'ai pas pu encore analysé, merci d'avoir
pu y consacré tout ce temps
à+
gilles

-----Message d'origine-----
Bonsoir,

Bon j'ai retravaillé tout ça, bien sur c'est à ma façon !
Un mieux vaux mieux que 2 tu l'auras !

Sub prefic082()

Const cteMaxf = 30000
Const cteMinf = 1

Const cteDossier = "C:Q.S.E3arborescence affairef-
Q.S.E"

Dim i, j As Integer
Dim dum As String

Dim f() As String
Dim mymsg
Dim oFS, oLecteur, oFichier, oFolder
Dim varListeNbr As Long

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder(cteDossier)

Application.ScreenUpdating = False
ChDir cteDossier

varListeNbr = oFolder.Files.Count
i = 1
If ((varListeNbr > cteMinf) And (varListeNbr <
cteMaxf)) Then
ReDim f(varListeNbr)
For Each oFichier In oFolder.Files
f(i) = oFichier.shortname
i = (i + 1)
Next oFichier

For i = 1 To varListeNbr
If (Mid(f(i), 1, 3) <> Range("B8").Value) Then
Application.DisplayAlerts = False
'Application.Dialogs(xlDialogOpen).Show

'Application.Dialogs(xlDialogSort).Show

Workbooks.Open cteDossier & f(i)
ActiveWorkbook.SaveAs cteDossier
& "082_06_" & f(i)
ActiveWorkbook.Close
Kill cteDossier & f(i)
Application.DisplayAlerts = True
End If
Next

End If

End Sub
'prudence sur alinéa

Michel

-----Message d'origine-----
Bonsoir,

J'ai eu un flash, je crois qu'il peut y avoir de la
récursivité. Je m'explique, Pour chaque fichier renommé
un autre est détruit, s'il y maj de la table des
matières, il y aura récursivité pour quelques tours.

Je propose de remodeler un peu comme sas le fait, un
premier passage pour obtenir la table des matières, et
un

second pour la manipulation.

J'y travaille, j'en ai maintenant besoin puisque une
collègue effectue des opérations similaires, il serait
bien de lui fournir quelque chose de stable.

Michel B.

-----Message d'origine-----
Bonjour,

J'ai retravaillé votre procédure :-)
Est-ce que cela répond à vos attentes ?
Voici donc :

Sub prefic082()

Dim f
Dim mymsg
Dim oFS, oLecteur, oFichier, oFolder

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder("C:Q.S.E3arborescence
affairef-Q.S.E")

Application.ScreenUpdating = False
ChDir "c:Q.S.E3arborescence affairef-Q.S.E"

For Each oFichier In oFolder.Files
f = oFichier.ShortName
If (Mid(f, 1, 3) <> Range("B8").Value) Then
Application.DisplayAlerts = False
Workbooks.Open oFichier
ActiveWorkbook.SaveAs "082_06_" & f
ActiveWorkbook.Close
Kill f
Application.DisplayAlerts = True
End If
Next

' f = Dir("*.xls")

' Do While Len(f) > 0
' If Mid(f, 1, 3) <> "082" Then
' Workbooks.Open f
' Application.DisplayAlerts = False
' ActiveWorkbook.SaveAs "082_06_" & f
' Application.DisplayAlerts = True
' ActiveWorkbook.Close
' End If
' mymsg = mymsg & Chr(13) & f
' f = Dir
' Loop

Application.ScreenUpdating = True
' MsgBox "Liste des fichiers: " & mymsg

End Sub

Michel B.

-----Message d'origine-----
Bonjour à tous...
et en particulier à LE STEPH qui a eu la gentillesse
de

m'envoyer , FIN 07 ,le code ci dessous et que je
devais

tenir au courant après le test (tardif !!!)

Le but recherché est de renommer les fichiers d'un
s/rep

par un prefixe qui se place devant le nom d'origine
des

fichiers
ça marche mais:
- ça ne me prend pas tous les fichiers
- et surtout ça ne traite pas le rep que je désigne,
mais

le repertoire d'enregistrement par défaut défini sur
le

PC

Par ailleurs, au lieu du prefixe prédéfini, j'aimerais
y

mettre la ref à la cellule B8 de la feuille ou est la
macro

par ex:
prefixe=[B8]

Sub prefic082()
Dim f
Dim mymsg
ChDir "c:Q.S.E3arborescence affairef-Q.S.E"
f = Dir("*.xls")
Application.ScreenUpdating = False
Do While Len(f) > 0
If Mid(f, 1, 3) <> "082" Then
Workbooks.Open f
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "082_06_" & f
Application.DisplayAlerts = True
ActiveWorkbook.Close
End If
mymsg = mymsg & Chr(13) & f
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Liste des fichiers: " & mymsg
End Sub

Merci à STEPH ou tout cerveau puissant pouvant
m'éclairer

à+
gilles
.

.

.

.

Bonjour Gilles,

Le REP qui est pris est celui défini par défaut
C'est peut-être parce que répertoire défini par défaut n'est pas sur le même

lecteur...
Essaie d'ajouter
ChDrive "C"
avant
ChDir "c:Q.S.E3arborescence affairef-Q.S.E"

Lydya

--------
"gilles" <anonymous@discussions.microsoft.com> a écrit dans le message de
news:cc3d01c48a6c$769b8060$a401280a@phx.gbl...
merci à STEPH et à MICHEL
J'en ai trop pour ma petite tête!
je regarde ça dès que j'ai un peu de dispo.
Pour STEPH , effectivement, je comprends que tu trouves ça
surprenant
Le REP qui est pris est celui défini par défaut
(coincidence?)
j'ai essayé en ne mettant qu'un repertoire (sans s/rep) ça
fait pareil
le rep pris en compte comporte environ 80 fichiers, dont
20 word et il traite exactement 50 fichiers xl
Pour MICHEL , je n'ai pas pu encore analysé, merci d'avoir
pu y consacré tout ce temps
à+
gilles

-----Message d'origine-----
Bonsoir,

Bon j'ai retravaillé tout ça, bien sur c'est à ma façon !
Un mieux vaux mieux que 2 tu l'auras !

Sub prefic082()

Const cteMaxf = 30000
Const cteMinf = 1

Const cteDossier = "C:Q.S.E3arborescence affairef-
Q.S.E"

Dim i, j As Integer
Dim dum As String

Dim f() As String
Dim mymsg
Dim oFS, oLecteur, oFichier, oFolder
Dim varListeNbr As Long

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder(cteDossier)

Application.ScreenUpdating = False
ChDir cteDossier

varListeNbr = oFolder.Files.Count
i = 1
If ((varListeNbr > cteMinf) And (varListeNbr <
cteMaxf)) Then
ReDim f(varListeNbr)
For Each oFichier In oFolder.Files
f(i) = oFichier.shortname
i = (i + 1)
Next oFichier

For i = 1 To varListeNbr
If (Mid(f(i), 1, 3) <> Range("B8").Value) Then
Application.DisplayAlerts = False
'Application.Dialogs(xlDialogOpen).Show

'Application.Dialogs(xlDialogSort).Show

Workbooks.Open cteDossier & f(i)
ActiveWorkbook.SaveAs cteDossier
& "082_06_" & f(i)
ActiveWorkbook.Close
Kill cteDossier & f(i)
Application.DisplayAlerts = True
End If
Next

End If

End Sub
'prudence sur alinéa

Michel

-----Message d'origine-----
Bonsoir,

J'ai eu un flash, je crois qu'il peut y avoir de la
récursivité. Je m'explique, Pour chaque fichier renommé
un autre est détruit, s'il y maj de la table des
matières, il y aura récursivité pour quelques tours.

Je propose de remodeler un peu comme sas le fait, un
premier passage pour obtenir la table des matières, et
un

second pour la manipulation.

J'y travaille, j'en ai maintenant besoin puisque une
collègue effectue des opérations similaires, il serait
bien de lui fournir quelque chose de stable.

Michel B.

-----Message d'origine-----
Bonjour,

J'ai retravaillé votre procédure :-)
Est-ce que cela répond à vos attentes ?
Voici donc :

Sub prefic082()

Dim f
Dim mymsg
Dim oFS, oLecteur, oFichier, oFolder

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oLecteur = oFS.GetDrive("C:")
Set oFolder = oFS.GetFolder("C:Q.S.E3arborescence
affairef-Q.S.E")

Application.ScreenUpdating = False
ChDir "c:Q.S.E3arborescence affairef-Q.S.E"

For Each oFichier In oFolder.Files
f = oFichier.ShortName
If (Mid(f, 1, 3) <> Range("B8").Value) Then
Application.DisplayAlerts = False
Workbooks.Open oFichier
ActiveWorkbook.SaveAs "082_06_" & f
ActiveWorkbook.Close
Kill f
Application.DisplayAlerts = True
End If
Next

' f = Dir("*.xls")

' Do While Len(f) > 0
' If Mid(f, 1, 3) <> "082" Then
' Workbooks.Open f
' Application.DisplayAlerts = False
' ActiveWorkbook.SaveAs "082_06_" & f
' Application.DisplayAlerts = True
' ActiveWorkbook.Close
' End If
' mymsg = mymsg & Chr(13) & f
' f = Dir
' Loop

Application.ScreenUpdating = True
' MsgBox "Liste des fichiers: " & mymsg

End Sub

Michel B.

-----Message d'origine-----
Bonjour à tous...
et en particulier à LE STEPH qui a eu la gentillesse
de

m'envoyer , FIN 07 ,le code ci dessous et que je
devais

tenir au courant après le test (tardif !!!)

Le but recherché est de renommer les fichiers d'un
s/rep

par un prefixe qui se place devant le nom d'origine
des

fichiers
ça marche mais:
- ça ne me prend pas tous les fichiers
- et surtout ça ne traite pas le rep que je désigne,
mais

le repertoire d'enregistrement par défaut défini sur
le

PC

Par ailleurs, au lieu du prefixe prédéfini, j'aimerais
y

mettre la ref à la cellule B8 de la feuille ou est la
macro

par ex:
prefixe=[B8]

Sub prefic082()
Dim f
Dim mymsg
ChDir "c:Q.S.E3arborescence affairef-Q.S.E"
f = Dir("*.xls")
Application.ScreenUpdating = False
Do While Len(f) > 0
If Mid(f, 1, 3) <> "082" Then
Workbooks.Open f
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "082_06_" & f
Application.DisplayAlerts = True
ActiveWorkbook.Close
End If
mymsg = mymsg & Chr(13) & f
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Liste des fichiers: " & mymsg
End Sub

Merci à STEPH ou tout cerveau puissant pouvant
m'éclairer

à+
gilles
.

.

.

.