AIDE MODIF MACRO

Résolu
Gwen59000 Messages postés 51 Date d'inscription   Statut Membre Dernière intervention   -  
Gwen59000 Messages postés 51 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,
J'ai cette macro qui reprend une liste de noms de clients dans un fichier excel et crée un fichier par client d'après un modèle :
Sub crea_fichiers()

Set fso = CreateObject("Scripting.FileSystemObject")

For Each c In Sheets(2).Range("C3:C1001")
If Not IsEmpty(c) Then
ficdest = "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\" & CStr(c.Value) & ".xls"

If Not fso.FileExists(pficdest) Then
fso.CopyFile "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\Modèle.xls", ficdest
End If
End If
Next c

End Sub

Est il possible en ajoutant un code qu'elle colle dans ce fichier créé le nom du client en B1 dans la feuille 1, en A1 dans la feuille 2 et en B1 dans la feuille 3 ?

Merci d'avance,
Gwénaël
A voir également:

7 réponses

Réponse 1 / 7
Bidouilleu_R Messages postés 1181 Date d'inscription   Statut Membre Dernière intervention   295
 
oui c'est possible!
après le dernier end if et avant le next..... le code en gras


Sub crea_fichiers()

Set fso = CreateObject("Scripting.FileSystemObject")

For Each c In Sheets(2).Range("C3:C1001")
If Not IsEmpty(c) Then
ficdest = "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\" & CStr(c.Value) & ".xls"

If Not fso.FileExists(pficdest) Then
fso.CopyFile "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\Modèle.xls", ficdest
End If
End If


Workbooks.Open ficdest

Sheets("Feuil1").Range("B1").Value = C.Value
Sheets("Feuil2").Range("A1").Value = C.Value
Sheets("Feuil3").Range("B1").Value = C.Value
ActiveWorkbook.Save
ActiveWorkbook.Close


Next c

End Sub
0
Réponse 2 / 7
tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   435
 
Bonjour Gwen59000,
Juste une petite correction, je viens de voir une faute de frappe sur le code que je t'avais donné :
If Not fso.FileExists(pficdest) => If Not fso.FileExists(ficdest)
0
Réponse 3 / 7
Gwen59000 Messages postés 51 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour à vous,

Petit problème, lorque la macro ne crée plus de fichier lorsque la liste de noms est vide la copie du nom sur la feuille 1, 2 et 3 continue sur toute la plage sélectionnée.

Peut on demander de faire une copie du nom sur les feuilles seulement si le fichier n'existe et s'arrêter une fois que les cellules sont vides dans la liste (comme le fait le code pour la création des fichiers).

Sinon c'est parfait.
0
Réponse 4 / 7
Bidouilleu_R Messages postés 1181 Date d'inscription   Statut Membre Dernière intervention   295
 
Ben! oui! j'ai fait le test sur 10... ma faute
on ajoute deux lignes pour sortir de la boucle

après le test if isisempty(....) ' si la cellule est vide on quitte la boucle for next
merci à tompols pourla correction, ; )
Sub crea_fichiers()

Set fso = CreateObject("Scripting.FileSystemObject")

For Each c In Sheets(2).Range("C3:C1001")
If Not IsEmpty(c) Then
ficdest = "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\" & CStr(c.Value) & ".xls"

If Not fso.FileExists(ficdest) Then
fso.CopyFile "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\Modèle.xls", ficdest
End If
else
exit for
End If


Workbooks.Open ficdest

Sheets("Feuil1").Range("B1").Value = C.Value
Sheets("Feuil2").Range("A1").Value = C.Value
Sheets("Feuil3").Range("B1").Value = C.Value
ActiveWorkbook.Save
ActiveWorkbook.Close


Next c

End Sub
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
Gwen59000 Messages postés 51 Date d'inscription   Statut Membre Dernière intervention  
 
Re

excusez moi, me suis trompé

Petit problème, alors que la macro ne crée plus de fichier lorsque la liste de noms est vide la copie du nom sur la feuille 1, 2 et 3 continue sur toute la plage sélectionnée.

Peut on demander de faire une copie du nom sur les feuilles seulement s'il y a une création de fichier et s'arrêter une fois que les cellules sont vides dans la liste (comme le fait le code pour la création des fichiers).

Merci
0
Réponse 6 / 7
tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   435
 
Re,
il suffit de déplacer le code donné par Bidouilleu_R dans une des 2 clauses If : 
Sub crea_fichiers()

Set fso = CreateObject("Scripting.FileSystemObject")

For Each c In Sheets(2).Range("C3:C1001")
    
    If Not IsEmpty(c) Then
        ficdest = "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\" & CStr(c.Value) & ".xls"
        
        If Not fso.FileExists(ficdest) Then
            fso.CopyFile "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\Modèle.xls", ficdest
            Workbooks.Open ficdest
            Sheets("Feuil1").Range("B1").Value = c.Value
            Sheets("Feuil2").Range("A1").Value = c.Value
            Sheets("Feuil3").Range("B1").Value = c.Value
            ActiveWorkbook.Save
            ActiveWorkbook.Close
        End If
        
    End If
    
Next c

End Sub

Là je l'ai replacé de façon à mettre la valeur uniquement dans les fichiers créés (ne s'execute pas si le fichier existe déjà) mais on peut encore "déplacer"....
0
Réponse 7 / 7
Gwen59000 Messages postés 51 Date d'inscription   Statut Membre Dernière intervention  
 
Re à vous deux,

C'est parfait !!!!!

Si je me concidère comme l'élève et vous comme les formateurs, le temps ou l'élève dépassera ses formateurs est encore loin devant moi...

Merci encore
0

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro
vincentphilippos -
tontong -

6 réponses
recup couleur de cellule sans macro
magouero -
JvDo -

7 réponses
EXCEL transformer chiffres en lettre -facture
roland -
JBB -

26 réponses
convertir des chiffres en lettres avec une unique formule
FOUAD_9000 -
Mike-31 -

34 réponses