AIDE MODIF MACRO
Résolu
Gwen59000
Messages postés
52
Statut
Membre
-
Gwen59000 Messages postés 52 Statut Membre -
Gwen59000 Messages postés 52 Statut Membre -
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
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
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Jitbit macro recorder - Télécharger - Confidentialité
- Macro maker - Télécharger - Divers Utilitaires
- Macro word - Guide
7 réponses
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
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
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)
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)
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.
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.
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
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
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
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
Re,
il suffit de déplacer le code donné par Bidouilleu_R dans une des 2 clauses If :
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"....
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"....
