Bonjour,
Ton fichier revisité avec une fonction personnalisée pour vérifier et modifier le nom de feuille.
Pour info, 31 est bien le nombre max de caractères pour le nom d'une feuille.
Cdlt.
Sub ouvreFichiers()
Dim NomFichier As Variant, Filtre As String, cmpt As Long, fich() As String
Dim wb As Workbook, nom As String
Filtre = "Tous les fichiers(*.xl*),*.xl*"
NomFichier = Application.GetOpenFilename(Filtre, 1, "Ouvrir", , True)
If IsArray(NomFichier) Then
Application.ScreenUpdating = False
For cmpt = LBound(NomFichier) To UBound(NomFichier)
Set wb = Workbooks.Open(NomFichier(cmpt))
nom = Mid(wb.Name, 1, InStrRev(wb.Name, ".") - 1)
nom = RenameWorksheet(nom)
With ThisWorkbook
.Activate
wb.Sheets(1).Copy After:=.Sheets(.Sheets.Count)
.Sheets(.Sheets.Count).Name = nom
End With
wb.Close
Next cmpt
ThisWorkbook.Sheets(1).Activate
End If
End Sub
Public Function RenameWorksheet(sText As String) As String
Dim x As String, newText As String
Dim I As Long
newText = ""
For I = 1 To Len(sText)
'x = Replace(sText, " ", "_")
x = Mid(sText, I, 1)
If InStr("/?,;*&:[]", x) > 0 Then
newText = newText & "_"
Else
newText = newText & x
End If
Next I
RenameWorksheet = Left(newText, 31)
End Function