AIDE MODIF MACRO

Résolu/Fermé

Gwen59000 Messages postés 51 Date d'inscription mardi 29 décembre 2009 Statut Membre Dernière intervention 19 avril 2010 - 10 févr. 2010 à 08:32
Gwen59000 Messages postés 51 Date d'inscription mardi 29 décembre 2009 Statut Membre Dernière intervention 19 avril 2010 - 10 févr. 2010 à 11:27

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:

AIDE MODIF MACRO
Macro word - Guide
Macro logiciel - Télécharger - Organisation
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Macro recorder - Télécharger - Confidentialité
Macro souris ✓ - Forum Windows

7 réponses

Réponse 1 / 7

Bidouilleu_R Messages postés 1181 Date d'inscription mardi 27 mai 2008 Statut Membre Dernière intervention 12 juillet 2012 289
10 févr. 2010 à 09:24

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

Réponse 2 / 7

tompols Messages postés 1273 Date d'inscription jeudi 29 juillet 2004 Statut Contributeur Dernière intervention 25 novembre 2013 435
10 févr. 2010 à 09:31

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)

Réponse 3 / 7

Gwen59000 Messages postés 51 Date d'inscription mardi 29 décembre 2009 Statut Membre Dernière intervention 19 avril 2010
10 févr. 2010 à 10:47

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.

Réponse 4 / 7

Bidouilleu_R Messages postés 1181 Date d'inscription mardi 27 mai 2008 Statut Membre Dernière intervention 12 juillet 2012 289
10 févr. 2010 à 10:53

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

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 mardi 29 décembre 2009 Statut Membre Dernière intervention 19 avril 2010
10 févr. 2010 à 10:56

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

Réponse 6 / 7

tompols Messages postés 1273 Date d'inscription jeudi 29 juillet 2004 Statut Contributeur Dernière intervention 25 novembre 2013 435
10 févr. 2010 à 10:57

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"....

Réponse 7 / 7

Gwen59000 Messages postés 51 Date d'inscription mardi 29 décembre 2009 Statut Membre Dernière intervention 19 avril 2010
10 févr. 2010 à 11:27

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

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro

Copie automatique tableau Excel sans macro

recup couleur de cellule sans macro

Lien de téléchargement de nbLettre.xla

tri automatque sur excel sans créer de macro

Discussions similaires

Newsletters