Enregistrement automatique avec choix du nom

[chris33]

Bonjour le forum,

J'ai un fichier excel que je souhaite dupliqué en x fichiers (entre 600 et 700 et oui!!) nommé distinctivement selon une liste dans une feuille :

exemple de ma liste.xls

Région Ville Code Postal
Aquitaine Bordeaux 33000
Aquitaine Bayonne 64100
Centre Tours 37000
...etc

Le code servirait à aller selectionner la ligne 1 de la colonne ville pour enregistrer le fichier sous le nom de Bordeaux.xls dans l'exemple, puis ensuite passer à la ligne 2 de la colonne ville pour enregistrer ce même fichier sous le nom de Bayonne.xls et ainsi de suite.

Encore et par avance, un grand merci pour votre aide
Bonne journée,
Chris33

 

[Léa]

Bonjour Criss


Si tes noms de ville sont en colonne 'B', voila un bout de code qui devrait faire l'affaire (chemin étant le chemin qui te mène au répertore où tu veux sauvegarder tes fichiers)

For I = 1 To Range('B65530').End(xlUp).Row
nom = Range('B' & I).Value
ChDir chemin
ActiveWorkbook.SaveAs Filename:= chemin & nom
Next I

Bon courage
Léa

 

[_Thierry]

Bonjour Chris, Lea, le Forum

Un autre approche quasi similaire avec celle de Léa, mais avec la méthode 'SaveCopyAs'...

Option Explicit
Sub TheMassCopier()
Dim TheCityRange As Range, Cell As Range
Dim TheFileName As String
Dim TheFilePath As String
Dim i As Integer

TheFilePath = ThisWorkbook.Path

        With Sheets('TheCities')
                Set TheCityRange = .Range('B2:B' & .Range('B1000').End(xlUp).Row)
        End With
        

        For Each Cell In TheCityRange
            TheFileName = Cell
                If Not TheFileName = '' Then
                        ThisWorkbook.SaveCopyAs TheFilePath & '\\' & TheFileName & '.xls'
                End If
        Next


End Sub

Ici on prends en compte une Feuille nommée 'TheCities' où se trouverait en colonne 'B' à partir de la ligne 2 (quelque soit le nombre de lignes), toutes les valeurs pour sauver le Fichier de base.

A noter aussi que 'TheFilePath = ThisWorkbook.Path' sauvera les copies dans le même répertoire que le fichier de base...

PS à noter que sur 600/700 fichiers ce doit être relativement long comme traitement...

Bon Appétit
@+Thierry

Modif => Ajout d'un Test si cellule Vide... (En prime !!)
PS Sans utiliser '' alors... If Not = !!! LoL

Message édité par: _Thierry, à: 23/02/2005 11:58

 

[chris33]

Merci au forum et à toi Léa en particulier .
@+
Chris

 

[chris33]

merci......ainsi qu'@+ Thierry...et aux autres... méa culpa, je ne t'avais pas encore lu !! quand j'ai adressé mes remerciements à Léa.

Bonne journée @ toutes et tous
Chris33

 

[_Thierry]

Ouh la, j'ai voulu modifier le code, mais ça cafouille un max maintenant lol !

Retentative :

Sub TheMassCopier()
Dim TheCityRange As Range, Cell As Range
Dim TheFileName As String
Dim TheFilePath As String
Dim i As Integer

TheFilePath = ThisWorkbook.Path

    With Sheets('TheCities')
        Set TheCityRange = .Range('B2:B' & .Range('B1000').End(xlUp).Row)
    End With
    
    
    For Each Cell In TheCityRange
    TheFileName = Cell
        If Not TheFileName = '' Then
                ThisWorkbook.SaveCopyAs TheFilePath & '\\' & TheFileName & '.xls'
        End If
    Next
End Sub

Sorry pour ces essais...
Bon App
@+Thierry

 

[chris33]

Merci @+ Thierry,
Bon app. à toi aussi, j'essaierai tout cela cet après midi.

@ bientôt sur le forum
Chris33