AIDE MODIF MACRO

Résolu
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
Configuration: Windows XP Internet Explorer 7.0

7 réponses

  1. Bidouilleu_R Messages postés 1209 Statut Membre 296
     
    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
  2. tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   460
     
    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
  3. Gwen59000 Messages postés 52 Statut Membre
     
    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
  4. Bidouilleu_R Messages postés 1209 Statut Membre 296
     
    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
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Gwen59000 Messages postés 52 Statut Membre
     
    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
  7. tompols Messages postés 1273 Date d'inscription   Statut Contributeur Dernière intervention   460
     
    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
  8. Gwen59000 Messages postés 52 Statut Membre
     
    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