Enregistrer autant de fichier que de noms contenus dans une cellule

bonjour,

j'ai recherché sur le forum plusieurs heures sans trouver exactement ce qu'il me fallait.

je souhaiterais créer autant de fichier que d'éléments situés dans la liste déroulante de la cellule B2

ma liste de fichiers est indiqué ci-dessous en [liste3] et contient dans cet exemple 5 éléments mais potentiellement 100 demain etc. soit 100 fichiers.

via la macro ci-dessous la création fonctionne cependant la donnée intégrée en B2 ne change pas. il me créée par exemple

fichier SPE0006.xlsx et fichier SPE0007.xlsx cependant l'information en cellule B2 est toujours la même: SPE0006 ce qui n'est pas ce que je recherche.

pourriez-vous m'aider svp

merci d'avance

_____

Option Explicit
Sub enregistrer_classeur()
Dim chemin As String, fichier As String, cell As Range

For Each cell In [liste3] 'Val 1: liste de valeurs

chemin = ThisWorkbook.Path
fichier = chemin & "\" & Range("B2") & ".xls"
ActiveWorkbook.SaveAs Filename:=cell

Next cell

End Sub

Bonjour,

A tester :

Sub Enregistrer_Classeur()

Dim Chemin As String, Fichier As String, Extension As String
Dim Cell As Range
Dim WbSource As Workbook

    Set WbSource = ActiveWorkbook
    Extension = "." & Split(WbSource.Name, ".")(1)
    Chemin = WbSource.Path & "\"

    For Each Cell In [liste3]
        Fichier = Chemin & Cell & Extension
        WbSource.SaveCopyAs Filename:=Fichier
    Next Cell
    Set WbSource = Nothing

End Sub

bonjour,

tout d'abord merci beaucoup pour votre aide et de votre hyper réactivité.

malheureusement, je souhaiterais que la cellule B2 soit également remplacée par la même donnée que le nom du fichier à savoir dans ce screeshot la 2e valeur SPE007 par exemple et idéalement reconvertir en fichier .xlsx et non plus avec macro pour que je puisse par la suite envoyer ces fichiers à mes fournisseurs svp

on y est presque merci encore pour votre aide

Il vous faut soit nommer votre cellule B2, soit indiquer le nom de l'onglet comme dans le ode ci-dessous :

Sub Enregistrer_Classeur()

Dim Chemin As String, Fichier As String
Dim Cell As Range
Dim WbSource As Workbook, WbCible As Workbook

    Set WbSource = ActiveWorkbook
    Chemin = WbSource.Path & "\"

    For Each Cell In [liste3]
        Sheets("XXXX").Range("B2") = Cell ' Nom de l'onglet à adapter
        Fichier = Chemin & Cell & ".xlsm"
        WbSource.SaveCopyAs Filename:=Fichier
    Next Cell
    Set WbSource = Nothing

End Sub

Quant au passage en xlsx, de mon point de vue, il vous faudra sans doute passer par la création d'un fichier temporaire avec un SaveCopyAs (donc .xlsm) puis créer une macro pour ouvrir ce fichier et le transformer en .xlsx avec un SaveAs en mettant à jour votre cellule B2 et en fin de procédure supprimer ce fichier temporaire.

Mais sans doute que je me trompe, et quelqu'un aura une astuce plus simple pour y parvenir.

bonjour,

bravo car en effet cela fonctionne et me permettra aussi d'améliorer ma connaissance ,

merci d'avoir pris le temps de me répondre c'est très sympa

merci

ps: pour la partie macro, je changerai l'extension d'une autre manière ce n'est plus que du "détail" le plus gros ayant été fait

merci encore