Salut,
Si j'ai bien compris, F1=a , F4=d tu veux renommer les feuilles et les fichiers suivant cette logique.
Colles ceci dans un module standard
Const Chemin$ = "C:\lenomdurépertoire" 'adapter le nom du dossier
Sub Princ()
Dim ToR, TfiN, T, C As Workbook
Dim I&, J&, NumFich&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ToR = Array("a", "b", "c", "d")
TfiN = Array("F1", "F2", "F3", "F4")
T = ChercheFichier("*.xls", Chemin)
If IsArray(T) Then
For I = LBound(T) To UBound(T)
NumFich = TesteNomF(ToR, NomFichier(T(I)))
If NumFich > 0 Then
Set C = Workbooks.Open(T(I))
With C
For J = LBound(TfiN) To UBound(TfiN)
On Error Resume Next
Set F = .Sheets(TfiN(J))
If Err = 0 Then _
If Not F.ProtectionMode Then F.Name = ToR(F.Index) 'on renomme la feuille
Next J
.SaveAs Chemin & "\" & TfiN(NumFich) & ".xls" 'on change le nom de fichier en l'enregistrant
.Close
End With
' Kill T(I) 'On efface le fichier d'origine, ôter le commentaire aprés les tests
End If
Next I
Else: MsgBox T
End If
End Sub
Function ChercheFichier(NomF$, Rep$, Optional Sourep As Boolean = False)'Zon
Dim I&, Tablo
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = Rep
.Filename = NomF
.SearchSubFolders = Sourep
.Execute
ReDim Tablo(1 To .FoundFiles.Count)
For I = 1 To .FoundFiles.Count
Tablo(I) = .FoundFiles(I)
Next I
End With
On Error GoTo 0
ChercheFichier = IIf(I > 1, Tablo, "Pas de fichier trouvé " & Rep)
End Function
Function NomFichier$(ByVal Ch$, Optional Ext As Boolean = False) 'Zon
'Retrouver le nom de fichier avec ou sans son extension à partir de son chemin complet
While InStr(Ch, "\") > 0
Ch = Mid(Ch, InStr(Ch, "\") + 1)
Wend
NomFichier = IIf(Ext, Ch, Left(Ch, Len(Ch) - 4))
End Function
Function TesteNomF&(T, ByVal NomF$)
Dim I&
For I = LBound(T) To UBound(T)
If T(I) = NomF Then TesteNomF = I + 1: Exit For
Next I
End Function
A+++